Theory Phi_BI
section ‹A Bunched Implications Equipped with Satisfaction›
text ‹It also contains a simplified BI specialized for only necessary constructs required
by ∗‹Multi-Term Form›.
➧ ∗‹Multi-Term Form› is the canonical form in the reasoning of φ-System, which demonstrates
abstractions directly and clearly in a localized way. It is characterized by form,
\[ ‹∃a. (x⇩1 ⦂ T⇩1 ∗ x⇩2 ⦂ T⇩2 ∗ ⋯ x⇩n ⦂ T⇩n) ∧ P› \]
where ‹P› is a pure proposition only containing free variables occurring in ‹x⇩1,⋯,x⇩n,a›.
It relates the concrete resource to a set of abstract objects ‹{(x⇩1,⋯,x⇩n) |a. P}› if
∗‹variables ‹a› are not free in ‹T⇩1,⋯,T⇩n››.
All specifications in φ-System are in Multi-Term Form. It is so pervasive that we use a set-like
notation to denote them,
\[ ‹(x⇩1 ⦂ T⇩1 ∗ x⇩2 ⦂ T⇩2 ∗ ⋯ x⇩n ⦂ T⇩n 𝗌𝗎𝖻𝗃 a. P)› \]
Readers may read it as a set,
\[ ‹{ x⇩1 ⦂ T⇩1 ∗ x⇩2 ⦂ T⇩2 ∗ ⋯ x⇩n ⦂ T⇩n |a. P }› \]
➧ ∗‹Simple Multi-Term Form› is a MTF where there is no existential quantification and the attached
‹P› is trivial ‹True›, viz., it is characterized by
\[ ‹x⇩1 ⦂ T⇩1 ∗ ⋯ ∗ x⇩n ⦂ T⇩n› \]
›
text ‹
Specifically, in this minimal specialized BI:
▪ It does not have a general additive conjunction (‹∧›) that connects any BI assertions,
but only the one (‹A 𝗌𝗎𝖻𝗃 P›) connects a BI assertion ‹A› and a pure assertion ‹P›,
because it is exactly what at most the MTF requires.
▪ Implication does not occur in assertions (of φ-SL), but it represents transformations of
abstraction so has a significant role in reasoning (rules).
We emphasize this transformation by assigning the implication with notation
‹A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P ≜ A ⟶ B ∧ P›, where ‹P› is a pure assertion.
The ‹P› helps to capture the information (in abstract domain) lost in the
weakening of this implication.
Currying implications like ‹A ⟶ B ⟶ C› are never used in φ-BI.
▪ Optionally we have universal quantification. It can be used to quantify free variables
if for any reason free variables are inadmissible. The universal quantifier is typically
not necessary in φ-BI and φ-SL, where we use free variables directly. However, in some
situation, like when we consider transitions of resource states and we want a transition
relation for each procedure, we need a single universally quantified assertion,
instead of a family of assertions indexed by free variables.
▪ The use of a implication represents a transformation of abstraction.
Therefore, implications are never curried or nested, always in form ‹X ⟶ Y ∧ P›
where ‹X, Y› are MTF and ‹P› is a pure proposition.
We denote them by notation ‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›.
▪ It only has multiplicative conjunctions, specialized additive conjunction described above,
existential quantification, and optionally universal quantification,
which are all the MTF requires,
plus implications that only occur in reasoning rules.
Any other things, should be some specific φ-Types expressing their meaning
specifically and particularly.
›
theory Phi_BI
imports "Phi_Logic_Programming_Reasoner.PLPR" Phi_Preliminary
abbrevs "<:>" = "⦂"
and "<trans>" = "𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌"
and "<transforms>" = "𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌"
and "<with>" = "𝗐𝗂𝗍𝗁"
and "<subj>" = "𝗌𝗎𝖻𝗃"
and "<when>" = "𝗐𝗁𝖾𝗇"
and "<remains>" = "𝗋𝖾𝗆𝖺𝗂𝗇𝗌"
and "<get>" = "𝗀𝖾𝗍"
and "<map>" = "𝗆𝖺𝗉"
and "<by>" = "𝖻𝗒"
and "<from>" = "𝖿𝗋𝗈𝗆"
and "<remaining>" = "𝗋𝖾𝗆𝖺𝗂𝗇𝗂𝗇𝗀"
and "<demanding>" = "𝖽𝖾𝗆𝖺𝗇𝖽𝗂𝗇𝗀"
and "<to>" = "𝗍𝗈"
and "<over>" = "𝗈𝗏𝖾𝗋"
and "<subst>" = "𝗌𝗎𝖻𝗌𝗍"
and "<for>" = "𝖿𝗈𝗋"
and "<TP>" = "𝒯𝒫"
begin
type_synonym 'a BI = ‹'a set›
subsection ‹Satisfaction›
definition Satisfaction :: ‹'a ⇒ 'a BI ⇒ bool› (infix "⊨" 50) where ‹(⊨) = (∈)›
subsubsection ‹Basic Rules›
lemma BI_eq_iff:
‹S = S' ⟷ (∀u. u ⊨ S ⟷ u ⊨ S')›
unfolding Satisfaction_def set_eq_iff ..
subsubsection ‹Basic Rewrites›
lemma sep_conj_expn[simp, φexpns]:
‹uv ⊨ (S * T) ⟷ (∃u v. uv = u * v ∧ u ⊨ S ∧ v ⊨ T ∧ u ## v)›
unfolding Satisfaction_def
using set_mult_expn .
lemma Subjection_expn[iff, φexpns]:
‹p ⊨ (S 𝗌𝗎𝖻𝗃 P) ⟷ p ⊨ S ∧ P›
unfolding Satisfaction_def using Subjection_expn_set .
lemma ExSet_expn[iff, φexpns]:
‹p ⊨ (ExSet S) ⟷ (∃x. p ⊨ S x)›
unfolding Satisfaction_def using ExSet_expn_set .
lemma Bottom_expn[iff, φexpns]:
‹¬ (p ⊨ {})›
unfolding Satisfaction_def by simp
lemma Zero_expn[iff, φexpns]:
‹¬ (p ⊨ 0)›
unfolding Satisfaction_def by simp
lemma One_expn[iff, φexpns]:
‹v ⊨ 1 ⟷ v = 1›
unfolding Satisfaction_def by simp
lemma Top_expn[iff, φexpns]:
‹v ⊨ top›
unfolding Satisfaction_def by simp
subsubsection ‹Reasoning Configuration›
φreasoner_group extract_pure_sat = (%extract_pure+100, [%extract_pure+100, %extract_pure+130])
for (‹𝗋EIF _ _›, ‹𝗋ESC _ _›)
in extract_pure_all and > extract_pure
‹Rules extracting BI properties down to Satisfaction›
subsection ‹φ-Type›
type_synonym ('concrete,'abstract) φ = " 'abstract ⇒ 'concrete BI "
definition φType :: "'b ⇒ ('a,'b) φ ⇒ 'a BI" (infix "⦂" 20) where " x ⦂ T ≡ T x"
text ‹Convention of name:
In ‹x ⦂ T›, we refer to ‹x› as the ∗‹object› or the ∗‹φ-type term› and ‹T› as the ∗‹φ-type›.
For convenience, when the context is unambiguous, we also call the entire ‹x ⦂ T› as 'φ-type',
but as ∗‹φ-type assertion› to be precise.
›
subsubsection ‹Basic \& Auxiliary Rules›
lemma φType_eqI:
‹(∀x p. p ⊨ (x ⦂ a) ⟷ p ⊨ (x ⦂ b)) ⟹ a = b›
unfolding φType_def Satisfaction_def by blast
lemma φType_protect_type_cong:
‹ x ≡ x'
⟹ x ⦂ T ≡ x' ⦂ T›
by simp
setup ‹Context.theory_map (PLPR_Rule_Gen.Rule_Gen_SS.map (
Simplifier.add_cong @{thm' φType_protect_type_cong}))›
ML_file ‹library/tools/simp_congruence.ML›
subsection ‹Inhabitance›
definition Satisfiable :: " 'a BI ⇒ bool "
where "Satisfiable S = (∃p. p ⊨ S)"
definition Inhabited
where ‹Inhabited T ⟷ (∃x. Satisfiable (x ⦂ T))›
abbreviation Inhabitance_Implication :: ‹'a BI ⇒ bool ⇒ bool› (infix "𝗂𝗆𝗉𝗅𝗂𝖾𝗌" 10)
where ‹S 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P ≡ 𝗋EIF (Satisfiable S) P ›
abbreviation Sufficient_Inhabitance :: ‹bool ⇒ 'a BI ⇒ bool› (infix "𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌" 10)
where ‹P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 S ≡ 𝗋ESC P (Satisfiable S) ›
declare [[
φreason_default_pattern ‹Satisfiable ?X ⟶ _› ⇒ ‹ERROR TEXT(‹bad form›)› (100)
and ‹_ ⟶ Satisfiable ?X› ⇒ ‹ERROR TEXT(‹bad form›)› (100)
and ‹Inhabited ?T› ⇒ ‹Inhabited ?T› (100),
φpremise_attribute once? [φreason? %local] for ‹Inhabited _› (%φattr)
]]
φreasoner_group extract_pure_phity = (10, [10,10]) for (‹x ⦂ T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P›, ‹P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ T›)
> extract_pure_fallback and < extract_pure
‹Entry points towards ‹Abstract_Domain› and ‹Abstract_Domain⇩L› ›
subsubsection ‹Basic Rules›
lemma Satisfiable_I:
‹x ⊨ S ⟹ Satisfiable S›
unfolding Satisfiable_def ..
lemma Satisfiable_fallback:
‹ X 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Satisfiable X ›
unfolding 𝗋EIF_def by blast
lemma Suf_Satisfiable_fallback:
‹ Satisfiable X 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 X ›
unfolding 𝗋ESC_def by blast
φreasoner_ML Satisfiable_fallback default 2 (‹_ 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 _›) =
‹fn (_, (ctxt,sequent)) => Seq.make (fn () =>
if Config.get ctxt Phi_Reasoners.is_generating_extraction_rule
then SOME ((ctxt, Thm.permute_prems 0 ~1 sequent), Seq.empty)
else SOME ((ctxt, @{thm Satisfiable_fallback} RS sequent), Seq.empty)
)›
φreasoner_ML Suf_Satisfiable_fallback default 2 (‹_ 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 _›) =
‹fn (_, (ctxt,sequent)) => Seq.make (fn () =>
if Config.get ctxt Phi_Reasoners.is_generating_extraction_rule
then SOME ((ctxt, Thm.permute_prems 0 ~1 sequent), Seq.empty)
else SOME ((ctxt, @{thm Suf_Satisfiable_fallback} RS sequent), Seq.empty)
)›
lemma [φreason 1000]:
‹ P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P
⟹ Satisfiable A›
unfolding 𝗋ESC_def Premise_def
by blast
lemma inhabited_type_EIF':
‹ 𝗋EIF (Inhabited T) (∃x. Satisfiable (x ⦂ T)) ›
unfolding Inhabited_def 𝗋EIF_def
by blast
bundle deriving_intabited_type = inhabited_type_EIF'[φreason default %extract_pure]
paragraph ‹Sum Type›
lemma [φreason 1020]:
‹ A a 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P
⟹ case_sum A B (Inl a) 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P›
by simp
lemma [φreason 1020]:
‹ B b 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P
⟹ case_sum A B (Inr b) 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P›
by simp
lemma [φreason 1000]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ A a 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P a)
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ B b 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Q b)
⟹ case_sum A B x 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 case_sum P Q x ›
by (cases x; simp)
subsection ‹Abstract Domain›
lemma typing_inhabited: "p ⊨ (x ⦂ T) ⟹ Satisfiable (x ⦂ T)"
unfolding Satisfiable_def φType_def by blast
definition Abstract_Domain :: ‹('c,'a) φ ⇒ ('a ⇒ bool) ⇒ bool›
where ‹Abstract_Domain T d ⟷ (∀x. x ⦂ T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 d x)›
definition Abstract_Domain⇩L :: ‹('c,'a) φ ⇒ ('a ⇒ bool) ⇒ bool›
where ‹Abstract_Domain⇩L T d ⟷ (∀x. d x 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ T)›
declare [[
φreason_default_pattern ‹Abstract_Domain ?T _› ⇒ ‹Abstract_Domain ?T _› (100)
and ‹Abstract_Domain⇩L ?T _› ⇒ ‹Abstract_Domain⇩L ?T _› (100),
φpremise_attribute once? [φreason? %local] for ‹Abstract_Domain _ _› (%φattr) ,
φpremise_attribute once? [φreason? %local] for ‹Abstract_Domain⇩L _ _› (%φattr)
]]
φreasoner_group abstract_domain_all = (1000, [1, 2000]) for (‹Abstract_Domain T d›, ‹Abstract_Domain⇩L T d›)
‹All reasoning rules giving ‹Abstract_Domain› or ‹Abstract_Domain⇩L››
and abstract_domain = (1000, [1000, 1000]) for (‹Abstract_Domain T d›, ‹Abstract_Domain⇩L T d›)
in abstract_domain_all
‹Normal reasoning rules for ‹Abstract_Domain›, ‹Abstract_Domain⇩L››
and abstract_domain_fallback = (1, [1,1]) for (‹Abstract_Domain T d›, ‹Abstract_Domain⇩L T d›) < abstract_domain
in abstract_domain_all
‹Fallbacks reasoning rules for ‹Abstract_Domain›, ‹Abstract_Domain⇩L› ›
and derived_abstract_domain = (60, [50,70]) for (‹Abstract_Domain T d›, ‹Abstract_Domain⇩L T d›)
in abstract_domain_all and < abstract_domain
‹Automatically derived rules›
and extract_𝗂𝗆𝗉𝗅𝗂𝖾𝗌 = (%extract_pure+40, [%extract_pure+40, %extract_pure+70])
for (‹𝗋EIF (A 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P) Q›, ‹𝗋ESC Q (A 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P)›,
‹𝗋EIF (A 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 P) Q›, ‹𝗋ESC Q (A 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 P)›)
and > extract_pure and < extract_pure_sat ‹›
subsubsection ‹Extracting Pure Facts›
lemma Inhabitance_Implication_𝒜EIF [φreason %extract_𝗂𝗆𝗉𝗅𝗂𝖾𝗌]:
‹ 𝗋ESC A' (Satisfiable A)
⟹ 𝗋EIF (A 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P) (A' ⟶ P) ›
unfolding 𝗋EIF_def 𝗋ESC_def
by blast
lemma Inhabitance_Implication_𝒜EIF_Sat:
‹ 𝗋EIF (A 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P) ((∃v. v ⊨ A) ⟶ P) ›
unfolding 𝗋EIF_def Satisfiable_def
by blast
lemma Inhabitance_Implication_𝒜ESC[φreason %extract_𝗂𝗆𝗉𝗅𝗂𝖾𝗌]:
‹ 𝗋EIF (Satisfiable A) A'
⟹ 𝗋ESC (A' ⟶ P) (A 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P) ›
unfolding 𝗋EIF_def 𝗋ESC_def
by blast
lemma Inhabitance_Implication_𝒜ESC_Sat:
‹ 𝗋ESC ((∃v. v ⊨ A) ⟶ P) (A 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P) ›
unfolding 𝗋ESC_def 𝗋EIF_def Satisfiable_def
by blast
lemma Sufficient_Inhabitance_𝒜EIF[φreason %extract_𝗂𝗆𝗉𝗅𝗂𝖾𝗌]:
‹ 𝗋EIF (Satisfiable A) A'
⟹ 𝗋EIF (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A) (P ⟶ A') ›
unfolding 𝗋EIF_def 𝗋ESC_def
by blast
lemma Sufficient_Inhabitance_𝒜EIF_Sat:
‹ 𝗋EIF (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A) (P ⟶ (∃v. v ⊨ A)) ›
unfolding 𝗋EIF_def 𝗋ESC_def Satisfiable_def
by blast
lemma Sufficient_Inhabitance_𝒜ESC[φreason %extract_𝗂𝗆𝗉𝗅𝗂𝖾𝗌]:
‹ 𝗋ESC A' (Satisfiable A)
⟹ 𝗋ESC (P ⟶ A') (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A) ›
unfolding 𝗋EIF_def 𝗋ESC_def
by blast
lemma Sufficient_Inhabitance_𝒜ESC_Sat:
‹ 𝗋ESC (P ⟶ (∃v. v ⊨ A)) (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A) ›
unfolding 𝗋ESC_def Satisfiable_def
by blast
bundle =
Inhabitance_Implication_𝒜EIF_Sat [φreason %extract_pure_sat]
Inhabitance_Implication_𝒜ESC_Sat [φreason %extract_pure_sat]
bundle =
Sufficient_Inhabitance_𝒜EIF_Sat [φreason %extract_pure_sat]
Sufficient_Inhabitance_𝒜ESC_Sat [φreason %extract_pure_sat]
bundle begin
unbundle extracting_Inhabitance_Implication_sat extracting_Sufficient_Inhabitance_sat
end
lemma [φreason %extract_pure_all]:
‹ (⋀x. 𝗋EIF ((x ⦂ T) 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 D x) (P x))
⟹ 𝗋EIF (Abstract_Domain T D) (All P) ›
unfolding Abstract_Domain_def 𝗋EIF_def
by blast
lemma [φreason %extract_pure_all]:
‹ (⋀x. 𝗋ESC (P x) ((x ⦂ T) 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 D x))
⟹ 𝗋ESC (All P) (Abstract_Domain T D) ›
unfolding Abstract_Domain_def 𝗋ESC_def
by blast
lemma [φreason %extract_pure_all]:
‹ (⋀x. 𝗋EIF (D x 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 (x ⦂ T)) (P x))
⟹ 𝗋EIF (Abstract_Domain⇩L T D) (All P) ›
unfolding Abstract_Domain⇩L_def 𝗋EIF_def
by blast
lemma [φreason %extract_pure_all]:
‹ (⋀x. 𝗋ESC (P x) (D x 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 (x ⦂ T)))
⟹ 𝗋ESC (All P) (Abstract_Domain⇩L T D) ›
unfolding Abstract_Domain⇩L_def 𝗋ESC_def
by blast
subsubsection ‹Basic Rules›
lemma [φreason default %extract_pure_phity]:
‹ Abstract_Domain T D
⟹ x ⦂ T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 D x›
unfolding Abstract_Domain_def Action_Tag_def
by blast
lemma [φreason default %extract_pure_phity]:
‹ Abstract_Domain⇩L T D
⟹ D x 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ T›
unfolding Abstract_Domain⇩L_def Action_Tag_def
by blast
lemma [φreason default %extract_pure_phity]:
‹ Abstract_Domain⇩L T D
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∃x. D x)
⟹ Inhabited T ›
unfolding Inhabited_def Abstract_Domain⇩L_def Premise_def 𝗋ESC_def
by blast
subsubsection ‹Fallback›
lemma [φreason default %abstract_domain_fallback]:
‹ Abstract_Domain T (λx. Satisfiable (x ⦂ T)) ›
unfolding Abstract_Domain_def 𝗋EIF_def
by simp
lemma [φreason default %abstract_domain_fallback]:
‹ Abstract_Domain⇩L T (λx. Satisfiable (x ⦂ T)) ›
unfolding Abstract_Domain⇩L_def 𝗋ESC_def
by simp
subsubsection ‹Configuration›
declare [[
φreason_default_pattern_ML ‹?x ⦂ ?T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 _› ⇒ ‹
fn ctxt => fn tm as (_ $ (_ $ (
_ $ (_ $ x $ _)) $ _)) =>
if is_Var x orelse not (Context_Position.is_visible_generic ctxt)
then NONE
else error (let open Pretty in string_of (chunks [
para "Malformed Implication Rule: in ‹x ⦂ T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 _› the x must be a schematic variable. But given",
Context.cases Syntax.pretty_term_global Syntax.pretty_term ctxt tm
]) end)› (1000),
φreason_default_pattern_ML ‹_ 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 _ ⦂ _› ⇒ ‹
fn ctxt => fn tm as (_ $ (_ $ _ $ (
_ $ (_ $ x $ _)))) =>
if is_Var x orelse not (Context_Position.is_visible_generic ctxt)
then NONE
else error (let open Pretty in string_of (chunks [
para "Malformed Sufficiency Rule: in ‹_ 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ T› the x must be a schematic variable. But given",
Context.cases Syntax.pretty_term_global Syntax.pretty_term ctxt tm
]) end)› (1000)
]]
setup ‹ PLPR_Template_Properties.add_property_kinds [
\<^pattern_prop>‹Abstract_Domain _ _›, \<^pattern_prop>‹Abstract_Domain⇩L _ _›
]›
subsubsection ‹Template Instantiation›
lemma Satisfiable_rewr_template[φreason_template name T.inh_rewr [simp]]:
‹ Abstract_Domain T D
⟹ Abstract_Domain⇩L T D'
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀x. D' x = D x) @tag 𝒜_template_reason None
⟹ Satisfiable (x ⦂ T) ≡ D x ›
unfolding 𝗋EIF_def 𝗋ESC_def Action_Tag_def Abstract_Domain_def Abstract_Domain⇩L_def Premise_def
by (clarsimp, smt (verit, best))
subsection ‹Auxiliary Tag›
definition φTag :: ‹mode ⇒ ('c,'x) φ ⇒ ('c,'x) φ›
where ‹φTag mode T ≡ T›
definition φTagA :: ‹mode ⇒ 'c BI ⇒ 'c BI›
where ‹φTagA mode T ≡ T›
subsection ‹Transformation of Abstraction›
text ‹The only meaningful implication ‹⟶› under the interpretation of φ data refinement›
definition Transformation :: " 'a BI ⇒ 'a BI ⇒ bool ⇒ bool " ("(2_)/ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (2_)/ 𝗐𝗂𝗍𝗁 (2_)" [13,13,13] 12)
where "(A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P) ⟷ (∀v. v ⊨ A ⟶ v ⊨ B ∧ P)"
abbreviation SimpleTransformation :: " 'a BI ⇒ 'a BI ⇒ bool " ("(2_)/ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (2_)" [13,13] 12)
where ‹SimpleTransformation T U ≡ Transformation T U True›
text ‹
Transformation ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. f x y› and its dual ‹y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗌𝗎𝖻𝗃 x. g x y›
constitute a classical Galios connection ‹(f,g)›. However, our method does not apply the Galios
connection directly as our method is synthetic (we do not analysis the relation between
concrete sets and abstract sets once after defining a φ-type,
but do deductions by means of transformation rules).
Comparing to analytic methods (the classical methods for data refinement), synthetic methods based
on a higher abstraction simplify representations and give more chances for automation (by means of an inference system),
and in addition, can be combined in program logics more natively.
›
text ‹The name of transformation is good in sense of corresponding to categorical natural transformation.
If we consider the state transition of a program as a category ‹𝒞›, two φ-types ‹T› and ‹U› form
functors over ‹𝒞›, and the transformation between ‹T› and ‹U› is the natural transformation between
the two functors. ›
text ‹TODO: move me
Our method simplifies program verification by lifting it onto an abstract domain.
However, it is hard to universally define what are abstract and what are not.
In a transformation ‹x ⦂ T ⟶ f(x) ⦂ U›, the abstract map ‹f› can have various expressions and
may fall back to concrete level such as ‹f(x) = @y(x ⦂ T ⟶ y ⦂ U)› (‹@› is Hilbert choice operator)
which is always a trivial solution of ‹f›.
The criterion about what expression of ‹f› is considered abstract can be given by user.
The abstract maps (‹f›) occurring in their annotations or given properties are assumed abstract.
In addition, if the abstract objects ‹x› are defined algebraically using Bounded Natural Functor,
the implied operators including mapper, relator, predicator, etc. are also considered abstract.
The range is unfixed and may extended if reasonable.
When we say we lift the verification onto an abstract domain, precisely we mean the proof obligation
extracted by our reasoning is a boolean assertion consisting of only the abstract operators as above
plus boolean connectives and other basic primitives like projections of product type.
It basically means the reasoning is made by composition of the rules giving abstraction, and the
extracted proof obligation is a composition of the abstract operators given in the rules.
›
subsubsection ‹Rules›
lemma φType_eqI_Tr:
‹ (⋀x. x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ U)
⟹ (⋀x. x ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T)
⟹ T = U›
unfolding φType_def Transformation_def Satisfaction_def
by auto
lemma φType_eqI_BI:
‹ (⋀x. (x ⦂ T) = (x ⦂ U))
⟹ T = U ›
unfolding φType_def fun_eq_iff
by blast
lemma transformation_refl[simp]:
"A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A" unfolding Transformation_def by fast
lemma transformation_trans:
"A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ (P ⟹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 C 𝗐𝗂𝗍𝗁 Q)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 C 𝗐𝗂𝗍𝗁 P ∧ Q"
unfolding Transformation_def Premise_def by auto
lemma mk_intro_transformation:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P ›
unfolding Transformation_def
by simp
lemma mk_elim_transformation:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B
⟹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
unfolding Transformation_def
by simp blast
lemma transformation_weaken:
‹ P ⟶ P'
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P'›
unfolding Transformation_def by simp
lemma transformation_intro_inhab:
‹ (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Satisfiable A ⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P ›
unfolding Transformation_def Satisfiable_def Satisfaction_def
by blast
lemma assertion_eq_intro:
‹ P 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Q
⟹ Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 P
⟹ P = Q›
unfolding Transformation_def BI_eq_iff by blast
lemma BI_eq_ToA:
‹ P = Q ⟷ (P 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Q) ∧ (Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 P) ›
unfolding BI_eq_iff Transformation_def
by blast
lemma BI_sub_transformation:
‹ S ≤ S' ⟷ (S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S') ›
unfolding Transformation_def Satisfaction_def subset_iff
by blast
lemma BI_sub_iff:
‹ S ≤ S' ⟷ (∀u. u ⊨ S ⟶ u ⊨ S') ›
unfolding Satisfaction_def subset_iff ..
lemma transformation_protector:
‹A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P ≡ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P› .
subsubsection ‹Forms of Reasoning›
consts 𝒯𝒫 :: action
𝒯𝒫' :: action
text ‹There are two kinds of transformation rule
▪ cast-rule: ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x) ⦂ U 𝗐𝗂𝗍𝗁 P(x)› binding on pattern ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ U 𝗐𝗂𝗍𝗁 _›,
which specifies how to transform a given φ-type ‹x ⦂ T› into the target type ‹U› and what is the
resulted abstract object with yielding any auxiliary pure facts ‹P(x)›.
▪ intro-rule: ‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 g(y) ⦂ U' 𝗐𝗂𝗍𝗁 P ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 P ∧ Q(y)› binding on
pattern ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 _›, which specifies how to construct ‹y ⦂ U› by construction
from ‹g(y) ⦂ U'›.
▪ elim-rule: ‹g(x) ⦂ T' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ∧ Q(x)› binding on
pattern ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _›, which specifies how to destruct ‹x ⦂ T› in sense of opening
its encapsulated abstraction to then deduce whatever we want.
(*TODO: revise the text below!!!*)
Among the rules generated from ‹φtype_def›, only the cast-rules are registered and activated.
Case-rule is point to point (from a specific type to another specific) so it is safe.
The intro-rule and the elim-rule reduce the abstraction level.
They cause the reasoning reduces to a lower level of abstraction.
Users can always activate the rules at their discretion.
Intro-rule and elim-rule can always be applied manually. It doesn't burden the user even a little because
the rules are used only when opening and closing an abstraction, in the case that should only happens
when building an interface or an internal operation of a data structure, where users can
write the intro-rule and the elim-rule at the beginning and the end of the program without thinking a bit.
›
text ‹In reasoning, the ‹P› in any goal is always an OUT-argument.›
text ‹Upon above, we present in addition two extension forms providing partial transformations
where a part of the source object may transform to only a part of the target object, leaving some
remainder of the source and some unsolved target part for later reasoning.
▸ ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x) ⦂ U›, the usual one-φtype-to-one-φtype transformation.
▸ ‹x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (f(x), r(x)) ⦂ U ∗[Cr] R› or alternatively
‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x) ⦂ U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cr] R(x)›, the transformation with remainders
▸ ‹x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (f(x), r(x)) ⦂ U ∗[Cr] R›, with both remainders and unsolved target parts.
where ‹Cw, Cr› are boolean conditions deciding if the remainder and respectively the unsolved aims
are presented.
The forms constitute a lattice where the reasoning of the bottom reduce to the top.
Note ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (f(x), r(x)) ⦂ U ∗[Cr] R› is not admissible though it is syntactically valid.
As it is entailed by the more general ‹x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (f(x), r(x)) ⦂ U ∗[Cr] R›, and more
important, the pattern of ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 …› also covers that of ‹x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _› when ‹T›
is variable, meaning inefficiency in selecting rule during reasoning, we dismiss ‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 …›
for the sake of reasoning performance and reducing the total number of reasoning rules.
In this way, designers of φ-types only require to provide two forms of rules,
‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U› and ‹x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[Cr] R›
›
definition REMAINS :: ‹ 'a::sep_magma BI ⇒ bool ⇒ 'a BI ⇒ 'a BI › ("_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _" [14,10,14] 13)
where ‹(X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) ≡ if C then X * R else X›
abbreviation ALWAYS_REMAINS :: ‹ 'a::sep_magma BI ⇒ 'a BI ⇒ 'a BI › ("_/ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 _" [14,14] 13)
where ‹(X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R) ≡ X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R›
definition φProd :: " ('concrete::sep_magma, 'abs_a) φ ⇒ ('concrete, 'abs_b) φ ⇒ ('concrete, 'abs_a × 'abs_b) φ" (infixr "∗" 70)
where "A ∗ B = (λ(a,b). A a * B b)"
definition Cond_φProd :: ‹ ('v,'x) φ ⇒ bool ⇒ ('v,'y) φ ⇒ ('v::sep_magma,'x × 'y) φ › ("_ ∗[_]/ _" [71,20,70] 70)
where ‹(T ∗[C] U) ≡ if C then T ∗ U else (λx. fst x ⦂ T)›
lemma φProd_expn[φexpns, simp]:
"concrete ⊨ (x ⦂ A ∗ B) ⟷ (∃ca cb. concrete = ca * cb ∧ cb ⊨ (snd x ⦂ B) ∧ ca ⊨ (fst x ⦂ A) ∧ ca ## cb)"
unfolding φProd_def φType_def by (cases x; simp) blast
lemma Cond_φProd_expn'[simp, φexpns]:
‹ p ⊨ (x ⦂ T ∗[C] U) = (if C then p ⊨ (x ⦂ T ∗ U) else p ⊨ (fst x ⦂ T)) ›
unfolding Cond_φProd_def φType_def
by clarsimp
lemma REMAINS_simp[simp, φsafe_simp]:
‹X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R ≡ X * R›
‹X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] R ≡ X›
unfolding REMAINS_def
by simp_all
text ‹In reasoning, the ‹P,R,W› in any goal are always OUT-arguments.›
ML ‹val phi_allow_source_object_to_be_not_variable =
Config.declare_bool ("phi_allow_source_object_to_be_not_variable", ⌂) (K false)›
ML_file ‹library/syntax/transformation.ML›
declare [[
φreason_default_pattern_ML ‹_ ⦂ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› ⇒ ‹fn ctxt =>
fn tm as (Trueprop $ (Transformation $ (PhiTyp $ x $ _) $ _ $ _)) => (
if not (is_Var (Term.head_of x)) andalso
Context_Position.is_visible_generic ctxt andalso
not (Config.get_generic ctxt phi_allow_source_object_to_be_not_variable)
then warning (let open Pretty in string_of (chunks [
para "The abstract object of the source of a transformation rule should be a variable.\n",
Context.cases Syntax.pretty_term_global Syntax.pretty_term ctxt tm
]) end)
else () ;
NONE
)› (1000),
φreason_default_pattern
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 _› ⇒ ‹ERROR(TEXT(‹Transformation rules must be tagged by either of the following categories, 𝒯𝒫, 𝒯𝒫'›))› (10)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫› ⇒
‹ERROR(TEXT(‹Malformed Rule› (?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫)))› (10)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫'› ⇒
‹ERROR(TEXT(‹Malformed Rule› (?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫')))› (10)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫› ⇒
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› (30)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
⇒ ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› (50)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA ?mode (?Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
⇒ ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA ?mode (?Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› (50)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
⇒ ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› (60)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA ?mode (_ ⦂ ?U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
⇒ ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA ?mode (?var_y ⦂ ?U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› (60)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
⇒ ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?U 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› (60)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA ?mode (_ ⦂ ?U) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
⇒ ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA ?mode (?var_y ⦂ ?U) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› (60)
and ‹?x ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?y ⦂ ?U ∗[?Cr] ?R 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫› ⇒
‹ERROR TEXT(‹Malformed Rule. Please use›
(x ⦂ ?T ∗[False] Top 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?y ⦂ ?U ∗[?Cr] ?R 𝗐𝗂𝗍𝗁 ?P)
‹instead of the given›
(?x ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?y ⦂ ?U ∗[?Cr] ?R 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫))› (71)
and ‹_ ⦂ ?T ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_Y 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
⇒ ‹_ ⦂ ?T ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'› (40)
and ‹?var_X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
⇒ ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'› (40)
and ‹(?var_x, _) ⦂ ?T ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
⇒ ‹_ ⦂ ?T ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?U ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'› (50)
and ‹?var_x ⦂ ?T ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?U ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
⇒ ‹_ ⦂ ?T ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?U ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'› (50)
]]
lemma REMAINS_expn[φexpns]:
‹ p ⊨ (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) ⟷ (if C then p ⊨ A * R else p ⊨ A) ›
unfolding REMAINS_def
by simp
subsubsection ‹Allocation of Priorities›
φreasoner_group
ToA_all = (100, [0, 4999]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _›
‹Rules of transformation›
ToA_bottom = (0, [0, 15]) in ToA_all
‹System transformation rules, of the lowest priority›
ToA = (100, [16, 4999]) in ToA_all > ToA_bottom
‹User rules for transformation›
ToA_bk = (100, [16, 999]) in ToA
‹Backtracking rules›
ToA_cut = (1000, [1000, 1399]) in ToA
‹Deterministic transformation rules without backtracking, meaning the reasoning
on the specified cases is definite and no branching.›
NToA_tgt = (1430, [1400, 1499]) > ToA_cut in ToA
‹›
ToA_splitting = (1550, [1500,1599]) > ToA_cut in ToA
‹Transformation rules splitting the reasoning goal into more subgoals›
ToA_splitting_target = (1600, [1600,1601]) > ToA_splitting in ToA
‹split the separation sequent in the target part and reason the tranformation for
each separated item one by one.›
ToA_assertion_cut = (1700, [1700,1899]) > ToA_splitting in ToA
‹Deterministic transformation rules between unsplitted assertions.›
ToA_normalizing = (2000, [1950, 2299]) > ToA_assertion_cut in ToA
‹Rules normalizing the transformation problem. A normalization rule should neither
branch nor yield new subgoal, i.e., always from onetransformation to another
transformaiton. If it branches, see %ToA_branches; if yields new assertions,
see %ToA_assertion_cut›
ToA_fixes_quant = (2500, [2500, 2590]) > NToA_tgt in ToA
‹Transformation rules fixing quantified variables.›
ToA_red = (2600, [2600, 2649]) > ToA_fixes_quant in ToA
‹Transformation rules reducing literal or trivial cases.›
ToA_success = (3000, [2960, 3499])
‹Transformation rules that are shortcuts leading to success on special cases›
ToA_systop = (4900, [4900, 4999]) in ToA
‹System rules of the highest priority›
ToA_assigning_var = (4100, [4100, 4110]) in ToA and < ToA_systop
‹Tranformation rules assigning variable targets or sources, of the highest priority
as occurrences of schematic variables are usually not considered in the subsequent
normal process of the reasoning, and may cause unexpected exception in them.›
ToA_refl = (4000, [3990, 4019]) in ToA and < ToA_assigning_var and > ToA_success
‹Reflexive tranformation rules›
ToA_splitting_source = (50, [50,50]) for ‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› < ToA_cut in ToA
‹split the separation sequent in the source part and reason the tranformation for
each separated item one by one.›
ToA_elim_intro = (19, [19,19]) in ToA < default
‹Elimination and introduction rules that unfold φ-types›
ToA_weak = (20, [20,24]) in ToA < default and > ToA_elim_intro
‹Weak transformation rules giving some reasoning support temporarily and expecting to be orverride›
ToA_derived = (50, [25,79]) in ToA < default and > ToA_weak
‹Automatically derived transformations. Many substructures are contained in this large range.›
ToA_derived_red = (150, [130,170]) for ‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› > ToA_derived > default in ToA
‹Automatically derived transformation reductions.›
ToA_weak_red = (120, [120,129]) for ‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› < ToA_derived_red in ToA
‹Weak reduction rules giving some reasoning support temporarily and expecting to be orverride›
ToA_user = (100, [80,119]) in ToA and < ToA_weak_red and > ToA_derived
‹default group for user rules›
declare [[
φdefault_reasoner_group ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› : %ToA_user (10)
and ‹?var 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› : %ToA_elim_intro (100)
and ‹_ ⦂ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› : %ToA_elim_intro (100)
]]
paragraph ‹Bottom Groups›
φreasoner_group
ToA_falling_latice = (1, [0,4]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› in ToA_bottom
‹Fallbacks of transformation rules›
ToA_unified_refl = (5, [5,6]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› in ToA_bottom and > ToA_falling_latice
‹Reflexive tranformation rules with unification, of a low priority because
unification is aggresive.›
ToA_derv_unify_refl = (7, [7,8]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› in ToA_bottom and > ToA_unified_refl
‹derived ToA_unified_refl that override the default behaviors.›
ToA_varify_target_object = (9, [9,9]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› in ToA_bottom and > ToA_derv_unify_refl
‹Varifies the fixed target object, using Object_Equiv›
ToA_inst_qunat = (10, [10,10]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› in ToA_bottom and > ToA_varify_target_object
‹Transformation rules instantiating quantified variables. It is unsafe unless
all fixable variables are fixed. If any variable is fixed later than the instantiation,
the instantiated schematic variable cannot caputure the later fixed variable.›
ToA_branches = (12, [11,15]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› in ToA_bottom and > ToA_inst_qunat
‹Branching transformation rules.›
paragraph ‹Fallback›
text ‹There are two trivial solutions for such problem.
On commutative algebra, a transformation can do nothing but simply return the source to the remainder
and demand subsequent transformation to the target. Such transformation is of the lowest priority
serving as a fallback of the ordinary reasoning.
‹ x ⦂ T ∗[True] U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (snd x, fst x) ⦂ U ∗[True] T ›
Another trivial solution is on unital algebras, where a transformation can assign the target object
to the identity element of the type so the source term directly go to the remainder.
‹ x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (one, fst x) ⦂ U ∗[True] T › where ‹one ⦂ U ≡ emp›
This is the fallback rule for unital algebras that are non-commutative, and in this case when
all transformations from T to U fail, assigning ‹U› to identity element is the only available search
branch so the fallback is safe. For commutative algebra, the previous fallback is applied.
When ‹U› is kept swapping and all source terms are passed, the still remaining ‹U› is assigned
with the identity element, so the case of ‹one ⦂ U ≡ emp› is still covered.
(*Implementation note:
By default, such rule is not activated as it really does nothing, and clients have a way
to know if the reasoning fails. However, if such fallback is expected, one can use reasoning goal
‹ Try Cs (x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[Cr] R) ›
in which boolean condition ‹Cs› returns whether the reasoning really ever made some changes.*)
›
text ‹Rules are given in §‹Reasoning/Basic Transformation Rules/Fallback››
subsubsection ‹Extracting Pure Facts Implies Inside›
lemma [φreason %extract_pure]:
‹ 𝗋EIF A P
⟹ 𝗋EIF (A @tag 𝒯𝒫) P ›
unfolding Action_Tag_def .
lemma [φreason %extract_pure]:
‹ 𝗋EIF A P
⟹ 𝗋EIF (A @tag 𝒯𝒫') P ›
unfolding Action_Tag_def .
lemma [φreason %extract_pure]:
‹ 𝗋ESC P A
⟹ 𝗋ESC P (A @tag 𝒯𝒫) ›
unfolding Action_Tag_def .
lemma [φreason %extract_pure]:
‹ 𝗋ESC P A
⟹ 𝗋ESC P (A @tag 𝒯𝒫') ›
unfolding Action_Tag_def .
text ‹This is used in φ-derivers, particularly in induction when›
lemma [φreason %extract_pure]:
‹ P⇩A 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A
⟹ B 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P⇩B
⟹ 𝗋EIF (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P) (P⇩A ⟶ P⇩B ∧ P) ›
unfolding Action_Tag_def 𝗋EIF_def 𝗋ESC_def Satisfiable_def Transformation_def
by clarsimp
ML ‹
fun extracting_elim_or_intro_ToA is_intro ctxt sequent =
let val target = case HOLogic.dest_Trueprop (Thm.major_prem_of sequent)
of Const(\<^const_name>‹𝗋EIF›, _) $ target $ _ => target
| _ => raise THM ("extracting_elim_or_intro_ToA", 1, [sequent])
fun get_concl (Const(\<^const_name>‹HOL.implies›, _) $ _ $ X) = get_concl X
| get_concl X = X
val concl = get_concl target
fun get_V (A, B) = if is_intro then A else B
val (A, B, Var p) = Phi_Syntax.dest_transformation (fst (HOLogic.dest_imp target))
val Var v = get_V (A, B)
fun parse_P (Var p) = p
| parse_P (Const(\<^const_name>‹HOL.conj›, _) $ Var p $ _) = p
in case try Phi_Syntax.dest_transformation concl
of SOME (A', B', P') => if get_V (A', B') = Var v andalso p = parse_P P'
then SOME ((ctxt, @{lemma' ‹ 𝗋EIF S C
⟹ 𝗋EIF ((A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A) ⟶ S) C ›
by simp}
RS sequent), Seq.empty)
else NONE
end
›
φreasoner_ML Transformation⇩I_𝒜EIF' %extract_pure+10 (‹𝗋EIF ((?var 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 ?var_P) ⟶ _) _ ›) = ‹
fn (_, (ctxt, sequent)) => Seq.make (fn () => extracting_elim_or_intro_ToA true ctxt sequent)
›
φreasoner_ML Transformation⇩E_𝒜EIF' %extract_pure+10 (‹𝗋EIF ((_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var 𝗐𝗂𝗍𝗁 ?var_P) ⟶ _) _ ›) = ‹
fn (_, (ctxt, sequent)) => Seq.make (fn () => extracting_elim_or_intro_ToA false ctxt sequent)
›
lemma ToA_EIF_sat:
‹ (⋀v. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 vA v : v ⊨ A)
⟹ (⋀v. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 vB v : v ⊨ B)
⟹ 𝗋EIF (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P) (∀v. vA v ⟶ vB v ∧ P) ›
unfolding 𝗋EIF_def Satisfiable_def Transformation_def Simplify_def
by clarsimp
lemma ToA_ESC_sat:
‹ (⋀v. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 vA v : v ⊨ A)
⟹ (⋀v. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 vB v : v ⊨ B)
⟹ 𝗋ESC (∀v. vA v ⟶ vB v ∧ P) (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P) ›
unfolding 𝗋ESC_def Satisfiable_def Transformation_def Simplify_def
by clarsimp
bundle = ToA_EIF_sat[φreason %extract_pure_sat]
ToA_ESC_sat[φreason %extract_pure_sat]
subsubsection ‹Reasoning Configure›
ML_file ‹library/tools/helper_reasoners.ML›
paragraph ‹Auxiliary Tools›
definition May_Assign :: ‹'a ⇒ 'a ⇒ bool›
where ‹May_Assign _ _ ≡ True›
φreasoner_group may_assign__all = (100, [1,2000]) for ‹May_Assign var val› ‹›
and may_assign_success = (2000, [2000,2000]) in may_assign__all ‹›
and may_assign_red = (1500, [1500, 1530]) in may_assign__all ‹›
and may_assign_fallback = (1, [1,1]) in may_assign__all ‹›
lemma [φreason %may_assign_success for ‹May_Assign _ _›]:
‹ May_Assign z z ›
unfolding May_Assign_def ..
lemma [φreason %may_assign_fallback]:
‹May_Assign x y ›
unfolding May_Assign_def ..
lemma [φreason %may_assign_red]:
‹ May_Assign y z
⟹ May_Assign (snd (x,y)) z ›
unfolding May_Assign_def ..
paragraph ‹Inhabitance Reasoning - Part II›
lemma [φreason 1000]:
‹ Generate_Implication_Reasoning (Satisfiable X ⟶ Y) (Satisfiable X) Y ›
unfolding Generate_Implication_Reasoning_def
..
lemma [φreason 1100]:
‹ Y 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P
⟹ Generate_Implication_Reasoning (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y) (Satisfiable X) P ›
unfolding Generate_Implication_Reasoning_def Transformation_def Satisfiable_def 𝗋EIF_def
by blast
lemma [φreason 1000]:
‹ Y 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Q
⟹ Generate_Implication_Reasoning (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P) (Satisfiable X) (Q ∧ P) ›
unfolding Generate_Implication_Reasoning_def Transformation_def Satisfiable_def 𝗋EIF_def
by blast
subsection ‹Top›
notation top ("⊤")
subsubsection ‹Rewrites›
lemma Top_Satisfiable[simp]:
‹Satisfiable ⊤ ⟷ True›
unfolding Satisfiable_def
by clarsimp
subsubsection ‹Transformation Rules›
φreasoner_group ToA_top = (%ToA_success, [%ToA_success-1, %ToA_success+1]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ 𝗐𝗂𝗍𝗁 _›
‹Transformation rules handling ⊤›
text ‹The target part is assumed having no schematic variable, so it is safe to do such shortcuts
comparing with the bottom-in-source.›
declare [[φtrace_reasoning = 1]]
lemma [φreason %ToA_top]:
‹Any 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤›
unfolding Transformation_def by blast
lemma [φreason %ToA_top]:
‹Any 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] ⊤›
unfolding Transformation_def
by simp
lemma [φreason %ToA_top]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * B
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] ⊤›
by simp
lemma [φreason %ToA_top-1 for ‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] _ @tag 𝒯𝒫›]:
‹ A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * R @tag 𝒯𝒫
⟹ A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R @tag 𝒯𝒫›
by simp
lemma [φreason %ToA_top-1 for ‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] _ @tag 𝒯𝒫›]:
‹ A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * C * R @tag 𝒯𝒫
⟹ A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * C 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R @tag 𝒯𝒫›
for A :: ‹'a :: sep_semigroup BI›
by (simp add: mult.assoc)
lemma [φreason %ToA_top+1 if ‹fn (ctxt,sequent) =>
case Phi_Syntax.dest_transformation (Thm.major_prem_of sequent)
of (_, (_ $ _ $ R), _)
=> let fun chk (Const(\<^const_name>‹times›, _) $ X $ Const(\<^const_name>‹top›, _)) = chk X
| chk (Const(\<^const_name>‹top›, _)) = false
| chk _ = true
in chk R
end›]:
‹ Any 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R * ⊤ 𝗐𝗂𝗍𝗁 P
⟹ Any 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * R 𝗐𝗂𝗍𝗁 P›
for Any :: ‹'a::sep_ab_semigroup BI›
by (simp add: mult.commute)
lemma [φreason %ToA_top]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R 𝗐𝗂𝗍𝗁 P
⟹ A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * R 𝗐𝗂𝗍𝗁 P›
for A :: ‹'a::sep_ab_semigroup BI›
unfolding Transformation_def
by (clarsimp, insert sep_disj_commuteI sep_mult_commute, blast)
lemma [φreason %ToA_top-1]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * R 𝗐𝗂𝗍𝗁 P›
for A :: ‹'a::sep_algebra BI›
unfolding Transformation_def
by clarsimp (metis mult_1_class.mult_1_left sep_magma_1_right)
lemma [φreason %fail]:
‹ FAIL TEXT(‹Sorry, currently we do not support solving ‹⊤ * R› problems on non-monoidal and non-commutative group.›)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ * R 𝗐𝗂𝗍𝗁 P›
unfolding Transformation_def FAIL_def
by blast
subsection ‹Bottom›
text ‹Despite of semantically ‹0 = ⊥› where syntactically ‹⊥ ≡ {}›, but there is not syntactically
‹0 ≡ {}›. We prefer to use ‹0› instead of the more usual ‹⊥› for the sake of forming
a semiring together with ‹1 ≡ emp›, ‹*›, ‹+ ≡ ∨⇩B⇩I›, to leverage the existing automation of semiring.›
abbreviation Bottom ("⊥⇩B⇩I") where ‹Bottom ≡ (0::'a::sep_magma BI)›
abbreviation Bottom_abs ("⊥⇩λ") where ‹Bottom_abs ≡ (0 :: 'b ⇒ 'a::sep_magma BI)›
lemma bot_eq_BI_bot [φprogramming_base_simps, φprogramming_simps]:
‹bot = ⊥⇩B⇩I›
unfolding zero_set_def ..
lemma zero_implies_any[simp]:
‹0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 Any›
unfolding Transformation_def zero_set_def Satisfaction_def by simp
subsubsection ‹Rewrites›
lemma Bot_Satisfiable[simp]:
‹ Satisfiable 0 ⟷ False ›
unfolding Satisfiable_def
by clarsimp
subsubsection ‹Transformation Rules›
φreasoner_group ToA_bot = (%ToA_cut+5, [%ToA_cut, %ToA_cut+10]) for ‹0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _›
‹Transformation rules when the source assertion is 0.
The rule is not of a highest priority because the target may contain schematic variables,
and the usual reasoning procedure is still required to unfold the target connective-by-connective
to ensure every variables inside is instantiated.›
lemma [φreason %ToA_cut for ‹0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹?var 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 False @tag 𝒯𝒫›
unfolding Action_Tag_def
by simp
lemma [φreason %ToA_bot for ‹0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹?var 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]:
‹0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Any] 0 𝗐𝗂𝗍𝗁 False @tag 𝒯𝒫›
using zero_implies_any Transformation_def Action_Tag_def
by simp
paragraph ‹Reductions›
lemma [φreason %ToA_red for ‹0 * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹?var * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]:
‹ 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X
⟹ 0 * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X›
by simp
lemma [φreason %ToA_red for ‹_ * 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ * ?var 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]:
‹ 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X
⟹ R * 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X›
by simp
lemma [φreason %ToA_red for ‹_ + 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ + ?var 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]:
‹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ Y + 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red for ‹0 + _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹?var + _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ 0 + Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ + 0 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ + ?var 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X + 0 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 0 + _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var + _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫@tag 𝒯𝒫› ]:
‹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 0 + X 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ + 0 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ + ?var 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X + 0 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 0 + _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var + _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 0 + X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ 0 x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ R * 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ R * 0 x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ 0 * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ 0 x * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
subsection ‹Unit›
subsubsection ‹Properties›
lemma [φreason %extract_pure]:
‹1 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 True›
unfolding 𝗋EIF_def
by blast
lemma [φreason %extract_pure]:
‹ True 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 1 ›
unfolding 𝗋ESC_def Satisfiable_def
by simp
lemma Emp_Satisfiable[simp]:
‹ Satisfiable 1 ⟷ True ›
unfolding Satisfiable_def
by clarsimp
subsubsection ‹Transformation Rules›
lemma [φreason %ToA_success]:
‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] X›
for X :: ‹'a::sep_magma_1 BI›
unfolding REMAINS_def Action_Tag_def by simp
lemma [φreason %ToA_red]:
" H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 * X 𝗐𝗂𝗍𝗁 P "
for X :: ‹'a::sep_magma_1 BI›
unfolding mult_1_left .
lemma [φreason %ToA_red]:
" H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 * X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P"
for X :: ‹'a::sep_magma_1 BI›
unfolding mult_1_left .
lemma [φreason %ToA_red]:
" R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ 1 * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P "
for X :: ‹'a::sep_magma_1 BI›
unfolding mult_1_left .
subsection ‹Additive Disjunction›
text ‹Is the \<^term>‹(+) :: 'a BI ⇒ 'a BI ⇒ 'a BI› directly›
subsubsection ‹Basic Rules›
lemma Disjunction_expn[iff, φexpns]:
‹p ⊨ (A + B) ⟷ p ⊨ A ∨ p ⊨ B›
unfolding Satisfaction_def by simp
lemma Add_Disj_Satisfiable[simp]:
‹ Satisfiable (A + B) ⟷ Satisfiable A ∨ Satisfiable B ›
unfolding Satisfiable_def
by clarsimp blast
lemma [φreason %cutting]:
‹ X 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 A
⟹ Y 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 B
⟹ X + Y 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 A ∨ B›
unfolding 𝗋EIF_def Satisfiable_def
by simp blast
lemma [φreason %cutting]:
‹ A 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 X
⟹ B 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 Y
⟹ A ∨ B 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 X + Y›
unfolding 𝗋ESC_def Satisfiable_def
by simp blast
text ‹The above two rules are reversible.›
lemma set_plus_inhabited[elim!]:
‹Satisfiable (S + T) ⟹ (Satisfiable S ⟹ C) ⟹ (Satisfiable T ⟹ C) ⟹ C›
unfolding Satisfiable_def
by (simp, blast)
lemma implies_union:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X + Y 𝗐𝗂𝗍𝗁 P›
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X + Y 𝗐𝗂𝗍𝗁 P›
unfolding Transformation_def
by simp_all
declare add_mono[φreason 1000]
subsubsection ‹Transformation Rules›
paragraph ‹In Source›
lemma [φreason %ToA_splitting]:
‹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P1
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P2
⟹ A + B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P1 ∨ P2›
by (simp add: Transformation_def)
lemma [φreason %ToA_splitting]:
‹ B * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P1
⟹ A * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P2
⟹ (A + B) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P1 ∨ P2›
by (simp add: Transformation_def distrib_left) blast
lemma [φreason %ToA_splitting+10]:
‹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] RB 𝗐𝗂𝗍𝗁 P1
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] RA 𝗐𝗂𝗍𝗁 P2
⟹ A + B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] RA + RB 𝗐𝗂𝗍𝗁 P1 ∨ P2›
by (cases C; simp add: Transformation_def; meson)
lemma [φreason %ToA_splitting+10]:
‹ B * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] RB 𝗐𝗂𝗍𝗁 P1
⟹ A * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] RA 𝗐𝗂𝗍𝗁 P2
⟹ (A + B) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] RA + RB 𝗐𝗂𝗍𝗁 P1 ∨ P2›
by (cases C; simp add: Transformation_def; blast)
paragraph ‹In Target›
lemma ToA_disj_target_A:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A + B 𝗐𝗂𝗍𝗁 P›
unfolding plus_set_def
by (metis implies_union(1) plus_set_def)
lemma ToA_disj_target_B:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A + B 𝗐𝗂𝗍𝗁 P›
by (simp add: Transformation_def)
declare [[φreason ! %ToA_branches ToA_disj_target_A ToA_disj_target_B for ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A + ?B 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫›]]
hide_fact ToA_disj_target_A ToA_disj_target_B
lemma ToA_disj_target_A':
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A + B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
unfolding Action_Tag_def REMAINS_def Transformation_def
by (cases C; simp add: distrib_left; blast)
lemma ToA_disj_target_B':
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A + B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
unfolding Action_Tag_def REMAINS_def Transformation_def
by (cases C; simp add: distrib_left; blast)
declare [[φreason ! %ToA_branches ToA_disj_target_A' ToA_disj_target_B'
for ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A + ?B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]]
hide_fact ToA_disj_target_A' ToA_disj_target_B'
subsection ‹Existential Quantification›
lemma ExSet_inhabited_E[elim!]:
‹Satisfiable (ExSet S) ⟹ (⋀x. Satisfiable (S x) ⟹ C) ⟹ C›
unfolding Satisfiable_def
by simp blast
lemma [φreason %cutting]:
‹ (⋀x. S x 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C x)
⟹ ExSet S 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Ex C ›
unfolding Satisfiable_def 𝗋EIF_def
by (simp; blast)
lemma [φreason %cutting]:
‹ (⋀x. C x 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 S x)
⟹ Ex C 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 ExSet S ›
unfolding Satisfiable_def 𝗋ESC_def
by (simp; blast)
lemma ExSet_Satisfiable[simp]:
‹ Satisfiable (∃*x. S x) ⟷ (∃x. Satisfiable (S x)) ›
unfolding Satisfiable_def
by clarsimp blast
subsubsection ‹Syntax›
syntax
"_SetcomprNu" :: "'a ⇒ pttrns ⇒ bool ⇒ 'a BI" ("_ 𝗌𝗎𝖻𝗃/ _./ _" [14,0,15] 14)
parse_translation ‹[
(\<^syntax_const>‹_SetcomprNu›, fn ctxt => fn [X,idts,P] =>
let fun subst l Bs (Free v) =
let val i = find_index (fn v' => v = v') Bs
in if i = ~1 then Free v else Bound (i+l)
end
| subst l Bs (A $ B) = subst l Bs A $ subst l Bs B
| subst l Bs (Abs(N,T,X)) = Abs(N,T, subst (l+1) Bs X)
| subst l Bs X = X
fun trans_one (Bs,C) (Const(\<^syntax_const>‹_unit›, _))
= Abs ("", \<^Type>‹unit›, C [])
| trans_one (Bs,C) (Const(\<^const_syntax>‹Pair›, _)
$ (Const (\<^syntax_const>‹_constrain›, _) $ Free (A, T) $ Ac)
$ B)
= Const(\<^const_syntax>‹case_prod›, dummyT) $ (
Const(\<^syntax_const>‹_constrainAbs›, dummyT)
$ Abs (A, T, trans_one ((A,T)::Bs, C) B)
$ Ac
)
| trans_one (Bs,C) (Const(\<^const_syntax>‹Pair›, _)
$ (Const (\<^syntax_const>‹_constrain›, _)
$ (Const (\<^syntax_const>‹_constrain›, _) $ Free (A, T) $ T') $ Ac)
$ B)
= Const(\<^const_syntax>‹case_prod›, dummyT) $ (
Const(\<^syntax_const>‹_constrainAbs›, dummyT)
$ (Const(\<^syntax_const>‹_constrainAbs›, dummyT)
$ Abs (A, T, trans_one ((A,T)::Bs, C) B)
$ T')
$ Ac
)
| trans_one (Bs,C) (Const(\<^const_syntax>‹Pair›, _)
$ Const (\<^syntax_const>‹_unit›, _)
$ B)
= Const(\<^const_syntax>‹case_prod›, dummyT) $ (
Const(\<^syntax_const>‹_constrainAbs›, dummyT)
$ Abs ("", dummyT, trans_one (Bs, C) B)
$ Const(\<^type_syntax>‹unit›, dummyT)
)
| trans_one (Bs,C) (Const (\<^syntax_const>‹_constrain›, _) $ Free (A, T) $ Ac)
= Const(\<^syntax_const>‹_constrainAbs›, dummyT)
$ Abs (A, T, C ((A,T)::Bs))
$ Ac
fun trans (Const (\<^syntax_const>‹_pttrns›, _) $ A $ B) Bs
= Const (\<^const_syntax>‹ExSet›, dummyT) $ trans_one (Bs,trans B) A
| trans B Bs
= Const (\<^const_syntax>‹ExSet›, dummyT) $ trans_one (Bs, (fn Bs =>
case P of Const (\<^const_syntax>‹top›, _)
=> subst 0 Bs X
| _ => Const (\<^const_syntax>‹Subjection›, dummyT) $ subst 0 Bs X $ subst 0 Bs P
)) B
in trans idts [] end)
]›
print_translation ‹[
(\<^const_syntax>‹ExSet›, fn ctxt => fn [X] =>
let fun subst l Bs (Bound i)
= if l <= i andalso i-l <= length Bs then List.nth(Bs, i-l) else Bound i
| subst l Bs (Abs (N,T,X)) = Abs (N,T, subst (l+1) Bs X)
| subst l Bs (A $ B) = subst l Bs A $ subst l Bs B
| subst l Bs X = X
fun trans (Vs,Bs) (Const(\<^const_syntax>‹case_prod›, _) $ Abs (A,T,X))
= if T = \<^Type>‹unit› andalso A = ""
then trans (Const(\<^syntax_const>‹_unit›, dummyT) :: Vs, Bs) X
else let val bound = Const(\<^syntax_const>‹_bound›, dummyT) $ Free(A,T)
in trans (bound::Vs, bound::Bs) X
end
| trans (Vs,Bs) (Abs(A,T, Const(\<^const_syntax>‹ExSet›, _) $ X))
= let val bound = Const(\<^syntax_const>‹_bound›, dummyT) $ Free(A,T)
val var = fold (fn v => fn v' => Const(\<^const_syntax>‹Pair›,dummyT) $ v $ v')
Vs bound
val (X',idts',P') = trans ([], bound :: Bs) X
in (X', Const(\<^syntax_const>‹_pttrns›, dummyT) $ var $ idts', P')
end
| trans (Vs,Bs0) (Abs(A,T,B))
= let val bound = Const(\<^syntax_const>‹_bound›, dummyT) $ Free(A,T)
val v' = if T = \<^Type>‹unit› andalso A = ""
then Const(\<^syntax_const>‹_unit›, dummyT)
else bound
val var = fold (fn v => fn v' => Const(\<^const_syntax>‹Pair›,dummyT) $ v $ v')
Vs v'
val Bs = bound :: Bs0
val (X,P) = case B of Const(\<^const_syntax>‹Subjection›, _) $ X $ P => (X,P)
| _ => (B, Const(\<^const_syntax>‹top›, dummyT))
in (subst 0 Bs X, var, subst 0 Bs P)
end
val (X',idts',P') = trans ([],[]) X
in Const(\<^syntax_const>‹_SetcomprNu›, dummyT) $ X' $ idts' $ P' end)
]›
subsubsection ‹Semantic Explanation›
text ‹Semantically, an existential quantification in BI actually represents union of resources
matching the existentially quantified assertion, as shown by the following lemma.›
lemma " Union { S x |x. P x } = (S x 𝗌𝗎𝖻𝗃 x. P x) "
by (simp add: set_eq_iff ExSet_def Subjection_def) blast
subsubsection ‹Basic Rules›
lemma BI_Ex_comm:
‹(∃* x y. A x y) = (∃* y x. A x y)›
unfolding BI_eq_iff
by (simp, blast)
subsubsection ‹Simplifications›
lemma ExSet_pair: "ExSet T = (∃*a b. T (a,b))"
unfolding BI_eq_iff by clarsimp
lemma ExSet_simps[simp, φprogramming_base_simps, φsafe_simp]:
‹ExSet 0 = 0›
‹ExSet (λ_. T) = T›
‹((∃*c. X c) 𝗌𝗎𝖻𝗃 PP) = (∃*c. X c 𝗌𝗎𝖻𝗃 PP)›
‹(F' y 𝗌𝗎𝖻𝗃 y. embedded_func f' P' x' y) = (F' (f' x') 𝗌𝗎𝖻𝗃 P' x')›
unfolding BI_eq_iff embedded_func_def
by simp_all
lemma ExSet_defined[φprogramming_base_simps, simp, φsafe_simp]:
‹(∃* x. F x 𝗌𝗎𝖻𝗃 x = y) = (F y)›
‹(∃* x. F x 𝗌𝗎𝖻𝗃 y = x) = (F y)›
‹(∃* x. F x 𝗌𝗎𝖻𝗃 x = y ∧ P x) = (F y 𝗌𝗎𝖻𝗃 P y)›
‹(∃* x. F x 𝗌𝗎𝖻𝗃 y = x ∧ P x) = (F y 𝗌𝗎𝖻𝗃 P y)›
unfolding BI_eq_iff
by simp_all
lemma Ex_transformation_expn:
‹((∃*x. A x) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P) ⟷ (∀x. A x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P)›
unfolding Transformation_def ExSet_expn
by blast
lemma ExSet_split_prod[φprogramming_base_simps, φsafe_simp]:
‹ (∃*x. (case x of (a,b) ⇒ f a b)) = (∃*a b. f a b) ›
unfolding BI_eq_iff
by clarsimp
lemma ExSet_subj_split_prod[φprogramming_base_simps, φsafe_simp]:
‹ (∃* x. A x 𝗌𝗎𝖻𝗃 (case x of (a,b) ⇒ P a b)) = (∃* a b. A (a,b) 𝗌𝗎𝖻𝗃 P a b) ›
unfolding BI_eq_iff
by clarsimp
paragraph ‹With Multiplicative Conjunction›
lemma ExSet_times_left [simp, φprogramming_base_simps, φsafe_simp]:
"((∃* c. T c) * R) = (∃* c. T c * R )"
by (simp add: BI_eq_iff, blast)
lemma ExSet_times_right[simp, φprogramming_base_simps, φsafe_simp]:
"(L * (∃*c. T c)) = (∃* c. L * T c)"
by (simp add: BI_eq_iff, blast)
paragraph ‹With Additive Disjunction›
lemma ExSet_addisj:
‹A + (∃*c. B c) ≡ ∃*c. A + B c›
‹(∃*c. B c) + A ≡ ∃*c. B c + A›
unfolding atomize_eq BI_eq_iff
by simp+
subsubsection ‹Transformation Rules›
lemma ExSet_transformation:
‹(⋀x. S x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S' x 𝗐𝗂𝗍𝗁 P)
⟹ ExSet S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ExSet S' 𝗐𝗂𝗍𝗁 P›
unfolding Transformation_def by (clarsimp, blast)
lemma ExSet_transformation_I:
‹ S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S' x 𝗐𝗂𝗍𝗁 P
⟹ S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (ExSet S') 𝗐𝗂𝗍𝗁 P›
unfolding Transformation_def by (clarsimp, blast)
lemma ExSet_transformation_I_R:
‹ S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S' x 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (ExSet S') 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
unfolding Transformation_def
by (cases C; clarsimp, blast)
lemma ExSet_additive_disj:
‹(∃*x. A x + B x) = (∃*x. A x) + (∃*x. B x)›
unfolding BI_eq_iff by (simp_all add: plus_fun) blast+
ML_file ‹library/tools/simproc_ExSet_expand_quantifier.ML›
subsubsection ‹ToA Reasoning›
lemma skolemize_transformation[φreason %ToA_fixes_quant]:
"(⋀x. T x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P x)
⟹ ExSet T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 Ex P"
unfolding Transformation_def by simp fastforce
lemma skolemize_transformation_R[φreason %ToA_fixes_quant+5]:
"(⋀x. T x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R x 𝗐𝗂𝗍𝗁 P x)
⟹ ExSet T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] ExSet R 𝗐𝗂𝗍𝗁 Ex P"
unfolding Transformation_def REMAINS_def by (cases C; simp; blast)
lemma skolemize_transformation_tR[φreason %ToA_fixes_quant+5]:
"(⋀x. T x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R x) 𝗐𝗂𝗍𝗁 P x)
⟹ ExSet T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] ExSet R) 𝗐𝗂𝗍𝗁 Ex P"
unfolding Transformation_def REMAINS_def φTagA_def
by (cases C; simp; blast)
lemma [φreason %ToA_fixes_quant]:
"(⋀x. T x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P x)
⟹ ExSet T * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 Ex P"
unfolding Transformation_def by simp fastforce
lemma [φreason %ToA_fixes_quant+5]:
"(⋀x. T x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R x 𝗐𝗂𝗍𝗁 P x)
⟹ ExSet T * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] ExSet R 𝗐𝗂𝗍𝗁 Ex P"
unfolding Transformation_def by (cases C; simp; fastforce)
lemma [φreason %ToA_fixes_quant+5]:
"(⋀x. T x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R x) 𝗐𝗂𝗍𝗁 P x)
⟹ ExSet T * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] ExSet R) 𝗐𝗂𝗍𝗁 Ex P"
unfolding Transformation_def φTagA_def
by (cases C; simp; fastforce)
text ‹Continued in \ref{supp-ex-conj}›
subsection ‹Additive Conjunction›
definition Additive_Conj :: ‹'a BI ⇒ 'a BI ⇒ 'a BI› (infix "∧⇩B⇩I" 35)
where ‹Additive_Conj = (∩)›
subsubsection ‹Basic Rules›
lemma Additive_Conj_expn[iff, φexpns]:
‹p ⊨ (A ∧⇩B⇩I B) ⟷ p ⊨ A ∧ p ⊨ B›
unfolding Satisfaction_def Additive_Conj_def by simp
lemma additive_conj_inhabited_E[elim!]:
‹Satisfiable (A ∧⇩B⇩I B) ⟹ (Satisfiable A ⟹ Satisfiable B ⟹ C) ⟹ C›
unfolding Satisfiable_def
by simp blast
lemma [φreason %cutting]:
‹ A 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P
⟹ B 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Q
⟹ A ∧⇩B⇩I B 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P ∧ Q›
unfolding Action_Tag_def 𝗋EIF_def
by blast
lemma
‹ P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A
⟹ Q 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 B
⟹ P ∧ Q 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 A ∧⇩B⇩I B›
unfolding Action_Tag_def Satisfiable_def
oops
text ‹There is no sufficiency reasoning for additive conjunction, because the sufficient condition
of ‹A ∧⇩B⇩I B› cannot be reasoned separately (by considering ‹A› and ‹B› separately).›
subsubsection ‹Simplification›
paragraph ‹With ExSet›
lemma ExSet_adconj:
‹A ∧⇩B⇩I (∃*c. B c) ≡ ∃*c. A ∧⇩B⇩I B c›
‹(∃*c. B c) ∧⇩B⇩I A ≡ ∃*c. B c ∧⇩B⇩I A›
unfolding atomize_eq BI_eq_iff
by simp+
subsubsection ‹Transformation Rules›
text ‹Non-pure Additive Conjunction (excludes those are used in pure propositions), is rarely used under our
refinement interpretation of BI assertions, because we can hardly imagine when and why an object
has to be specified by two abstractions that cannot transform to each other (if they can,
it is enough to use any one of them with a strong constraint over the abstraction, and transform it
to the other when needed). We believe those abstractions if exist are specific enough to be preferably
expressed by a specific φ-type equipped with ad-hoc reasoning rules.
To support additive conjunction, it brings enormous branches in the reasoning so affects the
reasoning performance. Before applying the rules introduced previously, we can add the following
rules which are also attempted subsequently in order and applied whenever possible.
‹X ⟶ A ⟹ X ⟶ B ⟹ X ⟶ A ∧ B› generates two subgoals.
‹(A ⟶ Y) ∨ (B ⟶ Y) ⟹ A ∧ B ⟶ Y› branches the reasoning. Specially, when ‹Y ≡ ∃x. P x› is an
existential quantification containing non-pure additive conjunction (e.g. ‹P x ≡ C x ∧ D x›),
the priority of eliminating ‹∧› or instantiating ‹∃› is significant.
We attempt the both priorities by a search branch.
(* If we instantiate first, the instantiation is forced to be identical in the two branches.
If we eliminate ‹∧› first, the ‹P› can be too strong *)
This rule is irreversible and we recall our hypothesis that φ-types between the conjunction are
considered disjoint, i.e., we only consider ‹(x ⦂ T) ∧ (y ⦂ U) ⟶ Y› when
either ‹x ⦂ T ⟶ Y› or ‹y ⦂ U ⟶ Y›.
›
lemma [φreason %ToA_splitting]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 P1
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P2
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A ∧⇩B⇩I B 𝗐𝗂𝗍𝗁 P1 ∧ P2 ›
unfolding Transformation_def
by simp
lemma NToA_conj_src_A:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ A ∧⇩B⇩I B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P ›
unfolding Transformation_def
by simp blast
lemma NToA_conj_src_B:
‹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ A ∧⇩B⇩I B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P ›
unfolding Transformation_def
by simp blast
text ‹Continued in \ref{supp-ex-conj}›
subsection ‹Subjection: Conjunction to a Pure Fact›
text ‹This is the only widely used additive conjunction under the interpretation of the φ data refinement›
subsubsection ‹Basic Rules›
lemma Subjection_inhabited_E[elim!]:
‹Satisfiable (S 𝗌𝗎𝖻𝗃 P) ⟹ (Satisfiable S ⟹ P ⟹ C) ⟹ C›
unfolding Satisfiable_def
by simp
lemma [φreason %cutting]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P ⟹ S 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C)
⟹ S 𝗌𝗎𝖻𝗃 P 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P ∧ C ›
unfolding Satisfiable_def Action_Tag_def Premise_def 𝗋EIF_def
by simp
lemma [φreason %cutting]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P ⟹ C 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 S)
⟹ P ∧ C 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 S 𝗌𝗎𝖻𝗃 P ›
unfolding Satisfiable_def Action_Tag_def Premise_def 𝗋ESC_def
by simp
lemma Subjection_imp_I:
‹ P
⟹ S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S' 𝗐𝗂𝗍𝗁 Q
⟹ S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S' 𝗌𝗎𝖻𝗃 P 𝗐𝗂𝗍𝗁 Q›
unfolding Transformation_def by simp
subsubsection ‹Simplification›
lemma Subjection_cong:
‹P ≡ P' ⟹ (P' ⟹ S ≡ S') ⟹ (S 𝗌𝗎𝖻𝗃 P) ≡ (S' 𝗌𝗎𝖻𝗃 P')›
unfolding atomize_eq BI_eq_iff by (simp, blast)
lemma Subjection_eq:
‹(A 𝗌𝗎𝖻𝗃 P) = (A' 𝗌𝗎𝖻𝗃 P) ⟷ (P ⟶ A = A')›
unfolding BI_eq_iff
by clarsimp blast
lemma Subjection_imp_simp[simp]:
‹ (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗌𝗎𝖻𝗃 P 𝗐𝗂𝗍𝗁 Q) ⟷ (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P ∧ Q) ›
unfolding Transformation_def by simp
lemma Subjection_True [simp, φprogramming_base_simps, φsafe_simp]:
‹(T 𝗌𝗎𝖻𝗃 True) = T›
unfolding BI_eq_iff by simp
lemma Subjection_Flase[simp, φprogramming_base_simps, φsafe_simp]:
‹(T 𝗌𝗎𝖻𝗃 False) = 0›
unfolding BI_eq_iff by simp
lemma Subjection_Subjection[simp, φprogramming_base_simps, φsafe_simp]:
‹(S 𝗌𝗎𝖻𝗃 P 𝗌𝗎𝖻𝗃 Q) = (S 𝗌𝗎𝖻𝗃 P ∧ Q)›
unfolding BI_eq_iff
by simp
lemma Subjection_Zero[simp, φprogramming_base_simps, φsafe_simp]:
‹(0 𝗌𝗎𝖻𝗃 P) = 0›
unfolding BI_eq_iff
by simp
lemma Subjection_transformation:
‹ S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S' 𝗐𝗂𝗍𝗁 P
⟹ S 𝗌𝗎𝖻𝗃 Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S' 𝗌𝗎𝖻𝗃 Q 𝗐𝗂𝗍𝗁 P›
unfolding Transformation_def by (simp; blast)
lemma Subjection_transformation_rewr:
‹ (A 𝗌𝗎𝖻𝗃 Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P) ⟷ (Q ⟶ (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P))›
unfolding Transformation_def by (simp; blast)
subparagraph ‹With Additive Conjunction›
lemma Subjection_addconj[simp, φprogramming_base_simps, φsafe_simp]:
‹(A 𝗌𝗎𝖻𝗃 P) ∧⇩B⇩I B ≡ (A ∧⇩B⇩I B) 𝗌𝗎𝖻𝗃 P›
‹B ∧⇩B⇩I (A 𝗌𝗎𝖻𝗃 P) ≡ (B ∧⇩B⇩I A) 𝗌𝗎𝖻𝗃 P›
unfolding atomize_eq BI_eq_iff
by (clarsimp; blast)+
subparagraph ‹With Additive Disjunction›
lemma Subjection_plus_distrib:
‹(A + B 𝗌𝗎𝖻𝗃 P) = (A 𝗌𝗎𝖻𝗃 P) + (B 𝗌𝗎𝖻𝗃 P)›
unfolding BI_eq_iff
by simp blast
subparagraph ‹With Multiplicative Conjunction›
lemma Subjection_times[simp, φprogramming_base_simps, φsafe_simp]:
‹(S 𝗌𝗎𝖻𝗃 P) * T = (S * T 𝗌𝗎𝖻𝗃 P)›
‹T * (S 𝗌𝗎𝖻𝗃 P) = (T * S 𝗌𝗎𝖻𝗃 P)›
unfolding BI_eq_iff
by (simp, blast)+
subsubsection ‹Transformation Rules›
φreasoner_group ToA_subj = (%ToA_assertion_cut, [%ToA_assertion_cut, %ToA_assertion_cut+20]) for ‹T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗌𝗎𝖻𝗃 Q 𝗐𝗂𝗍𝗁 P›
‹Transformation rules handling ‹Subjection››
lemma [φreason %ToA_subj]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (P ⟶ Q)
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗌𝗎𝖻𝗃 Q 𝗐𝗂𝗍𝗁 P "
unfolding Transformation_def Premise_def
by simp
lemma [φreason %ToA_red]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P ⟹
T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗌𝗎𝖻𝗃 True 𝗐𝗂𝗍𝗁 P "
unfolding Transformation_def by simp
lemma [φreason %ToA_subj]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (P ⟶ Q)
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗌𝗎𝖻𝗃 Q 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P "
unfolding Transformation_def Premise_def
by simp
lemma [φreason %ToA_red]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ⟹
T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗌𝗎𝖻𝗃 True 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P "
unfolding Transformation_def by simp
lemma [φreason %ToA_subj+10]:
"𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ T 𝗌𝗎𝖻𝗃 Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Transformation_def Premise_def Action_Tag_def
by simp blast
lemma [φreason %ToA_subj+20]:
"𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ T 𝗌𝗎𝖻𝗃 Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗌𝗎𝖻𝗃 Q 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Transformation_def Premise_def Action_Tag_def
by simp blast
lemma [φreason %ToA_subj+20]:
"𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ T 𝗌𝗎𝖻𝗃 Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗌𝗎𝖻𝗃 Q) 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Transformation_def Premise_def φTagA_def Action_Tag_def
by simp blast
lemma [φreason %ToA_subj+10]:
‹𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (T * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ (T 𝗌𝗎𝖻𝗃 Q) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
unfolding Transformation_def Premise_def Action_Tag_def
by simp blast
lemma [φreason %ToA_subj+20]:
"𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (T * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ (T 𝗌𝗎𝖻𝗃 Q) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗌𝗎𝖻𝗃 Q 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Transformation_def Premise_def Action_Tag_def
by simp blast
lemma [φreason %ToA_subj+20]:
"𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (T * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ (T 𝗌𝗎𝖻𝗃 Q) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 φTagA mode (U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗌𝗎𝖻𝗃 Q) 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Transformation_def Premise_def φTagA_def Action_Tag_def
by simp blast
subsection ‹Multiplicative Conjunction›
text ‹Is the \<^term>‹(*) :: ('a::sep_magma) BI ⇒ 'a BI ⇒ 'a BI› directly›
lemma set_mult_inhabited[elim!]:
‹Satisfiable (S * T) ⟹ (Satisfiable S ⟹ Satisfiable T ⟹ C) ⟹ C›
unfolding Satisfiable_def
by (simp, blast)
lemma [φreason %cutting]:
‹ X 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 A
⟹ Y 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 B
⟹ X * Y 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 A ∧ B›
unfolding 𝗋EIF_def
using set_mult_inhabited by blast
lemma
‹ A 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 X
⟹ B 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 Y
⟹ A ∧ B 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 X * Y›
unfolding Action_Tag_def Satisfiable_def
apply clarsimp
oops
text ‹There is no sufficiency reasoning for multiplicative conjunction, because if we reason A and B
separately, we loose the constraint about A and B are separatable, A ## B..›
lemma eq_left_frame:
‹ A = B ⟹ R * A = R * B ›
by simp
lemma eq_right_frame:
‹ A = B ⟹ A * R = B * R ›
by simp
lemma transformation_left_frame:
"U' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P ⟹ R * U' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R * U 𝗐𝗂𝗍𝗁 P "
unfolding Transformation_def split_paired_All sep_conj_expn by blast
lemma transformation_right_frame:
"U' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P ⟹ U' * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U * R 𝗐𝗂𝗍𝗁 P "
unfolding Transformation_def split_paired_All sep_conj_expn by blast
lemma transformation_bi_frame:
" R' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R 𝗐𝗂𝗍𝗁 P
⟹ L' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 L 𝗐𝗂𝗍𝗁 Q
⟹ L' * R' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 L * R 𝗐𝗂𝗍𝗁 P ∧ Q "
unfolding Transformation_def split_paired_All sep_conj_expn by blast
subsection ‹Finite Multiplicative Quantification (FMQ)›
definition Mul_Quant :: ‹('a ⇒ 'b::sep_algebra BI) ⇒ 'a set ⇒ 'b BI› ("✱")
where ‹Mul_Quant A S ≡ (prod A S 𝗌𝗎𝖻𝗃 finite S)›
text ‹Finite Multiplicative Quantification ‹✱i∈I. A⇩i› is inductively applying separation conjunction
over a finite family ‹{A⇩i}› of assertions indexed by ‹i∈I›, e.g., ‹(✱i∈I. A⇩i) = A⇩1 * A⇩2 * … * A⇩n› for
‹I = {1,2,…,n}››
syntax
"_Mul_Quant" :: "pttrn => 'a set => 'b => 'b::comm_monoid_mult" ("(2✱(_/∈_)./ _)" [0, 51, 14] 14)
translations
"✱i∈A. b" == "CONST Mul_Quant (λi. b) A"
syntax
"_qMul_Quant" :: "pttrn ⇒ bool ⇒ 'a ⇒ 'a" ("(2✱_ | (_)./ _)" [0, 0, 14] 14)
translations
"✱x|P. t" => "CONST Mul_Quant (λx. t) {x. P}"
subsubsection ‹Rewrites›
lemma sep_quant_sing[simp, φsafe_simp]:
‹✱ A {i} = A i›
unfolding Mul_Quant_def
by simp
lemma sep_quant_empty[simp, φsafe_simp]:
‹✱ A {} = 1›
unfolding Mul_Quant_def
by simp
lemma sep_quant_insert:
‹i ∉ I ⟹ ✱ A (insert i I) = A i * ✱ A I›
unfolding Mul_Quant_def
by (clarsimp simp add: Subjection_eq)
lemma sep_quant_reindex:
‹ inj_on f I
⟹ ✱i∈f`I. A i ≡ ✱i∈I. A (f i)›
unfolding Mul_Quant_def BI_eq_iff atomize_eq
by (clarsimp; rule; clarsimp simp add: finite_image_iff prod.reindex_cong)
lemma finite_prod_subjection:
‹finite I ⟹ (∏i∈I. A i 𝗌𝗎𝖻𝗃 P i) = ((∏i∈I. A i) 𝗌𝗎𝖻𝗃 (∀i∈I. P i))›
unfolding BI_eq_iff
proof (clarify; rule; clarsimp)
fix u
assume ‹finite I›
have ‹u ⊨ (∏i∈I. A i 𝗌𝗎𝖻𝗃 P i) ⟶ u ⊨ prod A I ∧ (∀x∈I. P x)›
by (induct arbitrary: u rule: finite_induct[OF ‹finite I›]; simp; blast)
moreover assume ‹u ⊨ (∏i∈I. A i 𝗌𝗎𝖻𝗃 P i)›
ultimately show ‹u ⊨ prod A I ∧ (∀x∈I. P x)›
by blast
qed
lemma sep_quant_subjection[φprogramming_base_simps, φprogramming_simps, φsafe_simp]:
‹(✱i∈I. A i 𝗌𝗎𝖻𝗃 P i) = ((✱i∈I. A i) 𝗌𝗎𝖻𝗃 (∀i∈I. P i))›
unfolding BI_eq_iff
by (clarify; rule; clarsimp simp add: Mul_Quant_def finite_prod_subjection)
lemma sep_quant_ExSet[φprogramming_base_simps, φprogramming_simps, φsafe_simp]:
‹(✱i∈I. ∃*j. A i j) = (∃*j. ✱i∈I. A i (j i))›
proof -
have t1: ‹⋀u. finite I ⟹ u ⊨ (∏i∈I. ExSet (A i)) ⟷ (∃x. u ⊨ (∏i∈I. A i (x i)))› (is ‹⋀u. _ ⟹ ?goal u›)
proof -
fix u
assume ‹finite I›
show ‹?goal u›
apply (induct arbitrary: u rule: finite_induct[OF ‹finite I›]; clarsimp)
apply (rule; clarsimp)
subgoal for x F xa ua v xb
by (rule exI[where x=‹λi. if i = x then xa else xb i›], rule exI[where x=ua], rule exI[where x=v],
simp, smt (verit) prod.cong)
by blast
qed
show ?thesis
unfolding BI_eq_iff Mul_Quant_def
by (clarsimp; rule; clarsimp simp add: t1)
qed
lemma sep_quant_swap:
‹⟦ finite I; finite J ⟧ ⟹(✱i∈I. ✱j∈J. A i j) = (✱j∈J. ✱i∈I. A i j)›
unfolding BI_eq_iff Mul_Quant_def
by (clarsimp; metis prod.swap)
lemma sep_quant_scalar_assoc:
‹(✱i∈I. ✱j∈J. A i j) = ((✱(i,j) ∈ I × J. A i j) 𝗌𝗎𝖻𝗃 finite I)›
unfolding BI_eq_iff Mul_Quant_def
by (clarsimp; rule;
clarsimp simp add: finite_prod_subjection ex_in_conv finite_cartesian_product_iff;
cases ‹I = {}›; cases ‹J = {}›; simp add: prod.cartesian_product)
lemma sep_quant_sep:
‹(✱i∈I. A i) * (✱i∈I. B i) = (✱i∈I. A i * B i)›
unfolding BI_eq_iff Mul_Quant_def
proof (clarsimp; rule; clarify)
fix u ua v
assume ‹finite I›
show ‹ua ⊨ prod A I ⟹ v ⊨ prod B I ⟹ ua ## v ⟹ ua * v ⊨ (∏i∈I. A i * B i)›
by (induct arbitrary: v u ua rule: finite_induct[OF ‹finite I›] ; clarsimp ;
smt (verit, best) sep_disj_commuteI sep_disj_multD1 sep_disj_multI1 sep_mult_assoc sep_mult_commute)
next
fix u
assume ‹finite I›
show ‹u ⊨ (∏i∈I. A i * B i) ⟹ ∃ua v. u = ua * v ∧ ua ⊨ prod A I ∧ v ⊨ prod B I ∧ ua ## v›
by (induct arbitrary: u rule: finite_induct[OF ‹finite I›] ; clarsimp ;
smt (verit) sep_disj_commuteI sep_disj_multD1 sep_disj_multI1 sep_mult_assoc sep_mult_commute)
qed
lemma sep_quant_merge_additive_disj:
‹(✱i∈I. A i) + (✱i∈I. B i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. A i + B i)›
unfolding Transformation_def Mul_Quant_def
proof (clarsimp; rule; clarsimp)
fix v
assume ‹finite I›
show ‹v ⊨ prod A I ⟹ v ⊨ (∏i∈I. A i + B i)›
by (induct arbitrary: v rule: finite_induct[OF ‹finite I›]; clarsimp; blast)
next
fix v
assume ‹finite I›
show ‹v ⊨ prod B I ⟹ v ⊨ (∏i∈I. A i + B i)›
by (induct arbitrary: v rule: finite_induct[OF ‹finite I›]; clarsimp; blast)
qed
lemma sep_quant_scalar_distr:
‹I ∩ J = {} ⟹ (✱i∈I. A i) * (✱j∈J. B j) = (✱k∈I + J. (if k ∈ J then B k else A k))›
unfolding Mul_Quant_def plus_set_def Subjection_times Subjection_Subjection
by (clarsimp simp add: Subjection_eq,
smt (verit) disjoint_iff prod.cong prod.union_disjoint)
subsubsection ‹Basic Rules›
lemma [φreason %cutting]:
‹ (⋀i∈S. A i 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P i)
⟹ (✱i∈S. A i) 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 (∀i∈S. P i) ›
unfolding Mul_Quant_def Action_Tag_def Satisfiable_def meta_Ball_def Premise_def 𝗋EIF_def
by (clarsimp; metis Satisfaction_def ex_in_conv prod_zero zero_set_iff)
subsubsection ‹Transformation›
paragraph ‹Reduction›
lemma [φreason %ToA_red]:
‹ A x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (✱i∈{x}. A i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ 1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (✱i∈{}. A i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ A x * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (✱i∈{x}. A i) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (✱i∈{}. A i) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A x 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈{x}. A i) 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈{}. A i) 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A x 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈{x}. A i) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈{}. A i) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
by simp
paragraph ‹Weak Normalization›
text ‹Source side is normalized by merging separations together
‹(✱i∈I. A i) * (✱i∈I. B i) ⟶ (✱i∈I. A i * B i)›
while the target side is normalized by splitting sep-quants into small separations
‹(✱i∈I. A i * B i) ⟶ (✱i∈I. A i) * (✱i∈I. B i)›.
It is because our reasoning strategy is splitting the target side first and scanning the source
side φ-type-by-type for each separated individual ‹φ›-type items.
The first step works in assertion form while the second step is between φ-types.
The ‹✱› is in assertion level, so the target side has to be split before the first step.
Before the second step, for each individual target item ‹(✱i∈I. x ⦂ T)› we shall apply
‹sep_quant_transformation› to strip off the outer ‹✱› in order to enter inside into φ-type level
so that the second step can continue.
This ‹sep_quant_transformation› may fail and if it fails, there is no way to enter the second step
∗‹in this unfinished reasoning mechanism right now›.
Later after the type embedding of ‹✱› is completed, the reasoning of ‹✱› will be forwarded to the
type embedding which provides full power of competence on that level.
›
lemma [φreason %ToA_weak_red]:
‹ (✱i∈I. A i * B i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (✱i∈I. A i) * (✱i∈I. B i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
unfolding sep_quant_sep
by simp
lemma [φreason %ToA_weak_red]:
‹ (✱i∈I. A i * B i) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (✱i∈I. A i) * (✱i∈I. B i) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
unfolding sep_quant_sep[symmetric]
by (simp add: mult.assoc)
lemma [φreason %ToA_weak_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. A i) * (✱i∈I. B i) 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. A i * B i) 𝗐𝗂𝗍𝗁 P ›
unfolding sep_quant_sep
by simp
lemma [φreason %ToA_weak_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. A i) * (✱i∈I. B i) * R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. A i * B i) * R 𝗐𝗂𝗍𝗁 P ›
unfolding sep_quant_sep
by simp
lemma [φreason %ToA_weak_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. A i) * (✱i∈I. B i) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. A i * B i) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ›
unfolding sep_quant_sep
by simp
paragraph ‹Transformation Functor›
lemma sep_quant_transformation[φreason %ToA_cut]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 I = J
⟹ (⋀i∈I. A i 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B i 𝗐𝗂𝗍𝗁 P i)
⟹ (✱i∈I. A i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈J. B i) 𝗐𝗂𝗍𝗁 (∀i∈I. P i) ›
unfolding Transformation_def Mul_Quant_def meta_Ball_def Premise_def 𝗋Guard_def
proof clarsimp
fix v
assume ‹finite J›
show ‹ (⋀x. x ∈ J ⟹ ∀v. v ⊨ A x ⟶ v ⊨ B x ∧ P x)
⟹ v ⊨ prod A J ⟹ v ⊨ prod B J ∧ (∀x∈J. P x) ›
by (induct arbitrary: v rule: finite_induct[OF ‹finite J›]; clarsimp; blast)
qed
lemma [φreason %ToA_cut]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 I = J
⟹ (⋀i∈J. A i 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B i 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R i 𝗐𝗂𝗍𝗁 P i)
⟹ (✱i∈I. A i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈J. B i) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] (✱i∈J. R i) 𝗐𝗂𝗍𝗁 (∀i∈J. P i) ›
unfolding REMAINS_def Premise_def 𝗋Guard_def
by (cases C; simp add: sep_quant_sep sep_quant_transformation)
paragraph ‹Scalar Associative›
lemma [φreason %ToA_normalizing]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 finite I ⟹ (✱(i,j) ∈ I × J. A i j) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P)
⟹ (✱i∈I. ✱j∈J. A i j) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P ›
unfolding sep_quant_scalar_assoc Premise_def Subjection_transformation_rewr
by simp
lemma [φreason %ToA_normalizing]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 finite I ⟹ (✱(i,j) ∈ I × J. A i j) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P)
⟹ (✱i∈I. ✱j∈J. A i j) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P ›
unfolding sep_quant_scalar_assoc Premise_def Subjection_transformation_rewr Subjection_times
by simp
lemma [φreason %ToA_normalizing]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱(i,j) ∈ I × J. B i j) 𝗐𝗂𝗍𝗁 P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 finite I
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. ✱j∈J. B i j) 𝗐𝗂𝗍𝗁 P ›
unfolding sep_quant_scalar_assoc Premise_def
by simp
lemma [φreason %ToA_normalizing]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱(i,j) ∈ I × J. B i j) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 finite I
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. ✱j∈J. B i j) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ›
unfolding sep_quant_scalar_assoc Premise_def
by simp
subsection ‹Universal Quantification›
definition AllSet :: ‹('a ⇒ 'b BI) ⇒ 'b BI› (binder "∀⇩B⇩I" 10)
where ‹AllSet X = {y. ∀x. y ∈ X x}›
lemma AllSet_expn[simp, φexpns]:
‹p ⊨ (∀⇩B⇩Ix. B x) ⟷ (∀x. p ⊨ B x)›
unfolding AllSet_def Satisfaction_def by simp
lemma AllSet_subset:
‹A ⊆ (∀⇩B⇩I x. B x) ⟷ (∀x. A ⊆ B x)›
unfolding AllSet_def subset_iff by (rule; clarsimp; blast)
lemma AllSet_refl:
‹(⋀x. refl (B x))
⟹ refl (∀⇩B⇩I x. B x)›
unfolding AllSet_def
by (simp add: refl_on_def)
lemma AllSet_trans:
‹(⋀x. trans (B x))
⟹ trans (∀⇩B⇩I x. B x)›
unfolding AllSet_def
by (smt (verit) mem_Collect_eq transD transI)
lemma BI_All_comm:
‹(∀⇩B⇩I x y. A x y) = (∀⇩B⇩I y x. A x y)›
unfolding BI_eq_iff
by (simp, blast)
lemma [elim!]:
‹Satisfiable (AllSet S) ⟹ (Satisfiable (S x) ⟹ C) ⟹ C›
unfolding Satisfiable_def
by clarsimp blast
lemma [φinhabitance_rule 1000]:
‹ S x 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C
⟹ AllSet S 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C ›
unfolding Action_Tag_def 𝗋EIF_def
by clarsimp blast
subsection ‹Supplementary Connective›
subsubsection ‹World Shift›
definition World_Shift :: ‹('c ⇒ 'd) ⇒ 'c BI ⇒ 'd BI› ("Ψ[_]" [10] 1000)
where ‹(Ψ[ψ] S) = {ψ u |u. u ⊨ S}›
text ‹Some thinking, what if we extend ‹ψ› to be a relation instead of a function? Then ‹Ψ[ψ]›
actually becomes the assertion-level counterpart of the φ-type ‹⨾›. However, the difficulty is
I cannot find the relational extension of closed homomorphism that gives us distributivity over
‹*› like ‹Ψ_Multiplicative_Conj›.›
lemma World_Shift_expn[φexpns, simp]:
‹p ⊨ Ψ[ψ] S ⟷ (∃u. p = ψ u ∧ u ⊨ S)›
unfolding World_Shift_def Satisfaction_def
by clarsimp
lemma World_Shift_expn'[φexpns, simp]:
‹p ∈ Ψ[ψ] S ⟷ (∃u. p = ψ u ∧ u ⊨ S)›
unfolding World_Shift_def Satisfaction_def
by clarsimp
text ‹The motivation of such modality is it is used later in Domainoid Extraction›
paragraph ‹Rewrites \& Transformations›
lemma Ψ_1:
‹ homo_one ψ
⟹ Ψ[ψ] 1 = 1 ›
unfolding BI_eq_iff homo_one_def
by simp
lemma Ψ_0:
‹ Ψ[ψ] 0 = 0 ›
unfolding BI_eq_iff
by clarsimp
lemma
‹ Ψ[ψ] (A ∧⇩B⇩I B) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (Ψ[ψ] A ∧⇩B⇩I Ψ[ψ] B) ›
unfolding Transformation_def
by (clarsimp; blast)
lemma Ψ_Multiplicative_Conj:
‹ closed_homo_sep ψ
⟹ Ψ[ψ] (A * B) = Ψ[ψ] A * Ψ[ψ] B›
unfolding BI_eq_iff
by (clarsimp simp add: closed_homo_sep_def closed_homo_sep_disj_def homo_sep_def
homo_sep_mult_def; rule; clarsimp; metis)
lemma Ψ_Mul_Quant:
‹ closed_homo_sep ψ
⟹ homo_one ψ
⟹ Ψ[ψ] (✱i∈S. A i) = (✱i∈S. Ψ[ψ] (A i)) ›
proof -
assume ‹closed_homo_sep ψ› and ‹homo_one ψ›
{ assume ‹finite S›
have ‹Ψ[ψ] (∏i∈S. A i) = (∏i∈S. Ψ[ψ] (A i))›
by (induct rule: finite_induct[OF ‹finite S›];
simp add: Ψ_1 ‹closed_homo_sep ψ› ‹homo_one ψ› Ψ_Multiplicative_Conj)
}
then show ‹Ψ[ψ] (✱i∈S. A i) = (✱i∈S. Ψ[ψ] (A i))›
unfolding Mul_Quant_def
by (smt (verit, best) Subjection_Flase Subjection_True Ψ_0)
qed
lemma Ψ_Additive_Disj:
‹Ψ[d] (A + B) = Ψ[d] A + Ψ[d] B›
unfolding BI_eq_iff
by (clarsimp; metis)
lemma Ψ_ExSet:
‹Ψ[d] (∃*c. S c) = (∃*c. Ψ[d] (S c))›
unfolding BI_eq_iff
by (clarsimp; metis)
lemma Ψ_Subjection:
‹Ψ[d] (S 𝗌𝗎𝖻𝗃 P) = (Ψ[d] S 𝗌𝗎𝖻𝗃 P)›
unfolding BI_eq_iff
by (clarsimp; metis)
section ‹Basic φ-Types \& Embedding of Logic Connectives›
subsection ‹Identity φ-Type›
definition Itself :: " ('a,'a) φ " where "Itself x = {x}"
lemma Itself_expn[φexpns, iff]:
"p ⊨ (x ⦂ Itself) ⟷ p = x"
unfolding φType_def Itself_def Satisfaction_def by auto
lemma Itself_inhabited_E[elim!]:
‹ Satisfiable (x ⦂ Itself) ⟹ C ⟹ C › .
lemma Itself_inhabited[φreason %cutting, simp, intro!]:
‹ Satisfiable (x ⦂ Itself) ›
unfolding Satisfiable_def
by blast
lemma [φreason %cutting]:
‹ Abstract_Domain Itself (λ_. True) ›
unfolding Abstract_Domain_def 𝗋EIF_def Satisfiable_def
by clarsimp
lemma [φreason %abstract_domain]:
‹ Abstract_Domain⇩L Itself (λ_. True) ›
unfolding Abstract_Domain⇩L_def 𝗋ESC_def Satisfiable_def
by simp
lemma Itself_E:
‹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 v ⊨ (x ⦂ T) ⟹ v ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T ›
unfolding Transformation_def Premise_def by simp
text ‹The introduction rule of Itself cannot be written in such ∃free-ToA form but in To-Transformation form.›
lemma satisfication_encoding:
‹ (x ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T 𝗐𝗂𝗍𝗁 P) ⟷ x ⊨ (y ⦂ T) ∧ P ›
unfolding Transformation_def by simp
subsubsection ‹Construction from Raw Abstraction represented by Itself ›
φreasoner_group abstract_from_raw = (100, [16, 1399]) for ‹v ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T›
> ToA_bottom and < ToA_splitting_target
‹Rules constructing abstraction from raw representations›
and abstract_from_raw_cut = (1000, [1000, 1030]) for ‹v ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T› in abstract_from_raw
‹Cutting rules constructing abstraction from raw representations›
and derived_abstract_from_raw = (70, [60,80]) for ‹v ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T›
in abstract_from_raw and < abstract_from_raw_cut
‹Derived rules›
declare [[φreason_default_pattern
‹ _ ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?T 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 › ⇒ ‹ _ ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?T 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 › (1120)
and ‹ _ ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 › ⇒ ‹ _ ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 › (1110)
]]
declare Itself_E[φreason default %ToA_falling_latice]
lemma [φreason default %ToA_falling_latice+1 except ‹?var ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ @tag 𝒯𝒫›]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 c = c' ⟹ c' ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 c = c'
⟹ c ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A ›
unfolding Premise_def
by simp
lemma [φreason %abstract_from_raw_cut]:
‹ c⇩a ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A
⟹ c⇩b ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 c⇩a ## c⇩b
⟹ (c⇩a * c⇩b) ⦂ Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A * B›
unfolding Transformation_def Premise_def
by (clarsimp; blast)
subsection ‹Embedding of ‹⊤››
definition φAny :: ‹('c, 'x) φ› ("⊤⇩φ") where ‹⊤⇩φ = (λ_. UNIV)›
setup ‹Sign.mandatory_path "φAny"›
lemma unfold [φprogramming_base_simps, φprogramming_simps, φsafe_simp]:
‹(x ⦂ ⊤⇩φ) = UNIV›
unfolding φAny_def φType_def ..
lemma expansion[simp]:
‹p ⊨ (x ⦂ ⊤⇩φ) ⟷ True›
unfolding φAny.unfold
by simp
setup ‹Sign.parent_path›
subsubsection ‹Basic Rules›
lemma [φreason %extract_pure]:
‹x ⦂ ⊤⇩φ 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 True›
unfolding 𝗋EIF_def
by simp
lemma [φreason %extract_pure]:
‹True 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ ⊤⇩φ›
unfolding 𝗋ESC_def Satisfiable_def
by simp
subsubsection ‹Transformation Rules›
paragraph ‹Reduction›
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ ⊤⇩φ 𝗐𝗂𝗍𝗁 P›
unfolding φAny.unfold
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ ⊤⇩φ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
unfolding φAny.unfold
by simp
paragraph ‹Separation Extraction›
text ‹In ToA, the ‹⊤⇩φ› behaviors like a wildcard that can absorb an undetermined number of φ-type items,
and which φ-type items are absorbed cannot be determined just from the type information. Therefore,
we require explicit annotations to be given to give the range of the absorption of ‹⊤⇩φ›.
TODO: make such annotation syntax.
›
lemma [φreason %ToA_top+1]:
‹ May_Assign (snd x) unspec
⟹ x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ((), unspec) ⦂ ⊤⇩φ ∗[False] ⊤⇩φ ›
unfolding Transformation_def
by clarsimp
subsection ‹Embedding of ‹⊥››
definition φBot :: ‹('c,'a) φ› ("⊥⇩φ") where ‹⊥⇩φ = (λ_. 0)›
setup ‹Sign.mandatory_path "φBot"›
lemma unfold[φprogramming_base_simps, φprogramming_simps, φsafe_simp]:
‹(x ⦂ ⊥⇩φ) = 0›
unfolding φBot_def φType_def ..
lemma expansion[simp]:
‹p ⊨ (x ⦂ ⊥⇩φ) ⟷ False›
unfolding φBot.unfold
by simp
setup ‹Sign.parent_path›
subsubsection ‹Basic Rules›
lemma [φreason %extract_pure]:
‹x ⦂ ⊥⇩φ 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 False ›
unfolding 𝗋EIF_def φBot.unfold Satisfiable_def
by simp
lemma [φreason %extract_pure]:
‹False 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x ⦂ ⊥⇩φ›
unfolding 𝗋ESC_def φBot.unfold Satisfiable_def
by simp
subsubsection ‹Transformation Rules›
paragraph ‹Reduction›
lemma [φreason %ToA_red]:
‹ 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ ⊥⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
unfolding φBot.unfold
by simp
lemma [φreason %ToA_red]:
‹ 0 * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (x ⦂ ⊥⇩φ) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
unfolding φBot.unfold
by simp
paragraph ‹Separation Extraction›
lemma [φreason %ToA_top]:
‹ May_Assign (snd x) unspec
⟹ x ⦂ ⊥⇩φ ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (any, unspec) ⦂ U ∗[False] ⊤⇩φ ›
unfolding Transformation_def
by clarsimp
subsection ‹Embedding of Separation Conjunction›
lemma φProd_expn' [φprogramming_base_simps, φprogramming_simps, φsafe_simp]:
‹((a,b) ⦂ A ∗ B) = (a ⦂ A) * (b ⦂ B)›
unfolding BI_eq_iff by (simp add: set_mult_expn) blast
lemma φProd_expn'':
‹ NO_MATCH (xx,yy) x
⟹ (x ⦂ A ∗ B) = (fst x ⦂ A) * (snd x ⦂ B)›
unfolding BI_eq_iff by (cases x; simp add: set_mult_expn) blast
bundle φProd_expn = φProd_expn'[simp] φProd_expn''[simp]
subsubsection ‹Basic Rules›
lemma [φreason %extract_pure]:
‹ fst x ⦂ T1 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C1
⟹ snd x ⦂ T2 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C2
⟹ x ⦂ T1 ∗ T2 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C1 ∧ C2›
unfolding Satisfiable_def Action_Tag_def 𝗋EIF_def
by (cases x; simp, blast)
paragraph ‹Frame Rules›
lemma transformation_right_frame_ty:
‹(⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a = fst x ⟹ a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(a) ⦂ U 𝗐𝗂𝗍𝗁 P(a))
⟹ x ⦂ T ∗ R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x ⦂ U ∗ R 𝗐𝗂𝗍𝗁 P(fst x) ›
unfolding Transformation_def
by (cases x; clarsimp; blast)
lemma transformation_left_frame_ty:
‹(⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a = snd x ⟹ a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(a) ⦂ U 𝗐𝗂𝗍𝗁 P(a))
⟹ x ⦂ R ∗ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apsnd f x ⦂ R ∗ U 𝗐𝗂𝗍𝗁 P(snd x) ›
unfolding Transformation_def
by (cases x; clarsimp; blast)
subsubsection ‹Abstract Domain›
text ‹The upper bound of the abstraction domain is simple.›
text ‹However, the lower bound is non-trivial, in which case we have to show the separation combination
is compatible between the two φ-types. The compatibility is encoded by predicate ‹Separation_Disj⇩ψ›
and ‹Separation_Disj⇩φ› which are solved by means of the domainoid introduced later.
So the rules are given until \cref{phi-types/Domainoid/App}.
›
subsubsection ‹Transformation Rules›
lemma destruct_φProd_φapp:
‹x ⦂ T ∗ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst x ⦂ T) * (snd x ⦂ U)›
by (cases x; simp add: Transformation_def set_mult_expn) blast
lemma φProd_transformation:
" x ⦂ N 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x' ⦂ N' 𝗐𝗂𝗍𝗁 Pa
⟹ y ⦂ M 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y' ⦂ M' 𝗐𝗂𝗍𝗁 Pb
⟹ (x,y) ⦂ N ∗ M 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x',y') ⦂ N' ∗ M' 𝗐𝗂𝗍𝗁 Pa ∧ Pb"
unfolding Transformation_def by simp blast
paragraph ‹Reduction›
lemma [φreason %ToA_red]:
" A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst x ⦂ N) * (snd x ⦂ M) 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ N ∗ M 𝗐𝗂𝗍𝗁 P"
by (cases x; simp add: φProd_expn')
lemma [φreason %ToA_red+1 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (_,_) ⦂ _ ∗ _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ _ ∗ _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
" A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x ⦂ N) * (y ⦂ M) 𝗐𝗂𝗍𝗁 P
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x,y) ⦂ N ∗ M 𝗐𝗂𝗍𝗁 P"
by (simp add: φProd_expn')
text ‹The reductions on source are not enabled as they may break the form of original source assertion›
paragraph ‹Separation Extraction›
text ‹see §‹Technical φ-Types required in Reasoning Transformation/Separation Extraction of ‹φ›Prod››
lemma [φreason %ToA_cut except ‹(_ :: ?'a::sep_semigroup set) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹ fst a ⦂ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ a ⦂ A ∗[True] X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ((b, snd a), unspec) ⦂ (Y ∗ X) ∗[False] ⊤⇩φ 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
unfolding Action_Tag_def Transformation_def
by clarsimp blast
subsection ‹Embedding of Conditioned Separation Conjunction›
lemma Cond_φProd_expn:
‹ (x ⦂ T ∗[C] U) = (if C then (x ⦂ T ∗ U) else (fst x ⦂ T)) ›
unfolding Cond_φProd_def φType_def
by clarsimp
lemma Cond_φProd_expn_const[simp, φprogramming_base_simps, φsafe_simp]:
‹T ∗[True] U ≡ T ∗ U›
‹x ⦂ T ∗[False] U ≡ fst x ⦂ T›
by (simp_all add: Cond_φProd_def φType_def)
subsubsection ‹Basic Rules›
lemma [φreason %extract_pure]:
‹ fst x ⦂ T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ snd x ⦂ U 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Q)
⟹ x ⦂ T ∗[C] U 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P ∧ (C ⟶ Q) ›
unfolding Satisfiable_def 𝗋EIF_def
by (cases C; clarsimp; blast)
paragraph ‹Frame Rules›
lemma transformation_right_frame_conditioned_ty:
‹(⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a = fst x ⟹ a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(a) ⦂ U 𝗐𝗂𝗍𝗁 P(a))
⟹ x ⦂ T ∗[C] R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x ⦂ U ∗[C] R 𝗐𝗂𝗍𝗁 P(fst x) ›
unfolding Transformation_def
by (cases C; cases x; clarsimp; blast)
lemma transformation_left_frame_conditioned_ty:
‹(⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a = snd x ⟹ a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(a) ⦂ U 𝗐𝗂𝗍𝗁 P(a))
⟹ x ⦂ R ∗[C] T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apsnd f x ⦂ R ∗[C] U 𝗐𝗂𝗍𝗁 C ⟶ P(snd x) ›
unfolding Transformation_def
by (cases C; cases x; clarsimp; blast)
subsubsection ‹Transformation Rules›
text ‹see §‹Reasoning/Supplementary Transformations/Type-embedding of Conditioned Remains››
subsection ‹Embedding of Empty›
definition φNone :: ‹('v::one, unit) φ› ("○")
where ‹φNone = (λx. { 1 }) ›
lemma φNone_expn[φexpns, simp]:
‹p ⊨ (x ⦂ φNone) ⟷ p = 1›
unfolding φNone_def φType_def Satisfaction_def
by simp
lemma φNone_inhabited[elim!]:
‹Satisfiable (x ⦂ φNone) ⟹ C ⟹ C› .
subsubsection ‹Rewrites›
lemma φNone_itself_is_one[simp, φsafe_simp]:
‹(any ⦂ φNone) = 1›
unfolding BI_eq_iff by simp
lemma φProd_φNone:
‹((x',y) ⦂ ○ ∗ U) = ((y ⦂ U) :: 'a::sep_magma_1 BI)›
‹((x,y') ⦂ T ∗ ○) = ((x ⦂ T) :: 'b::sep_magma_1 BI)›
unfolding BI_eq_iff
by (simp_all add: set_mult_expn)
subsubsection ‹Transformation Rules›
lemma [φreason %ToA_red]:
" H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (any ⦂ ○) * X 𝗐𝗂𝗍𝗁 P "
for X :: ‹'a::sep_magma_1 BI›
unfolding mult_1_left φNone_itself_is_one .
lemma [φreason %ToA_red]:
" H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ H 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (any ⦂ ○) * X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P"
for X :: ‹'a::sep_magma_1 BI›
unfolding mult_1_left φNone_itself_is_one .
lemma [φreason %ToA_red]:
" R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ (any ⦂ ○) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P "
for X :: ‹'a::sep_magma_1 BI›
unfolding mult_1_left φNone_itself_is_one .
lemma [φreason %ToA_success]:
‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 any ⦂ ○ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] X›
for X :: ‹'a::sep_magma_1 BI›
unfolding REMAINS_def Action_Tag_def by simp
lemma [φreason %ToA_success+1]:
‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 () ⦂ ○ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] X›
for X :: ‹'a::sep_magma_1 BI›
unfolding REMAINS_def Action_Tag_def by simp
subsection ‹Injection into Unital Algebra›
definition φSome :: ‹('v, 'x) φ ⇒ ('v option, 'x) φ› ("● _" [91] 90)
where ‹● T = (λx. { Some v |v. v ∈ (x ⦂ T) })›
lemma φSome_expn[simp, φexpns]:
‹p ⊨ (x ⦂ ● T) ⟷ (∃v. p = Some v ∧ v ⊨ (x ⦂ T))›
unfolding φType_def φSome_def Satisfaction_def
by simp
subsubsection ‹Rewrites›
lemma φSome_φProd:
‹ ● T ∗ ● U = ● (T ∗ U) ›
by (rule φType_eqI; clarsimp; force)
lemma φSome_eq_term_strip:
‹ (x ⦂ ● T) = (y ⦂ ● U) ≡ (x ⦂ T) = (y ⦂ U) ›
unfolding atomize_eq BI_eq_iff
by clarsimp blast
subsubsection ‹Transformation Rules›
lemma φSome_transformation_strip:
‹ x ⦂ ● T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ● U 𝗐𝗂𝗍𝗁 P ≡ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 P ›
unfolding atomize_eq Transformation_def
by clarsimp blast
lemma [φreason %ToA_cut]:
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ ● T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ● U 𝗐𝗂𝗍𝗁 P ›
unfolding φSome_transformation_strip .
lemma [φreason %ToA_cut]:
‹ x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[Cr] R 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ ● T ∗[Cw] ● W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ● U ∗[Cr] ● R 𝗐𝗂𝗍𝗁 P›
by (cases Cw; cases Cr; simp add: φSome_φProd φSome_transformation_strip)
subsubsection ‹Properties›
lemma Abstract_Domain_φSome[φreason %abstract_domain]:
‹ Abstract_Domain T D
⟹ Abstract_Domain (● T) D ›
unfolding Abstract_Domain_def 𝗋EIF_def Satisfiable_def
by clarsimp
subsection ‹Technical φ-Types required in Reasoning Transformation›
subsubsection ‹Variant of Empty φ-Type for Arbitrary Abstract Objects›
definition φNone_freeobj :: ‹('v::one, 'x) φ› ("○⇩𝗑") where ‹○⇩𝗑 = (λx. 1)›
lemma φNone_freeobj_expn[φexpns, simp, φsafe_simp]:
‹ (x ⦂ ○⇩𝗑) = 1›
unfolding φType_def φNone_freeobj_def
by simp
lemma φSome_φNone_freeobj:
‹ x ⦂ T ∗ ○⇩𝗑 ≡ fst x ⦂ T›
‹ y ⦂ ○⇩𝗑 ∗ T ≡ snd y ⦂ T›
‹ x' ⦂ ○⇩𝗑 ∗ (○⇩𝗑 :: ('v::sep_magma_1, 'x) φ) ≡ 1›
for T :: ‹'b ⇒ 'a::sep_magma_1 set›
unfolding atomize_eq BI_eq_iff
by ((rule φType_eqI)?; clarsimp)+
subsubsection ‹Conditioned Product at Left›
definition LeftCond_φProd :: ‹ ('v,'x) φ ⇒ bool ⇒ ('v,'y) φ ⇒ ('v::sep_magma,'x × 'y) φ › ("_ [_]∗ _" [69,20,70] 68)
where ‹(T [C⇩T]∗ U) ≡ if C⇩T then T ∗ U else (λx. snd x ⦂ U)›
lemma LeftCond_φProd_expn[φexpns, simp]:
‹ c ⊨ (x ⦂ T [C⇩T]∗ U) ⟷ (if C⇩T then c ⊨ (x ⦂ T ∗ U) else c ⊨ (snd x ⦂ U))›
unfolding LeftCond_φProd_def φType_def
by (cases C⇩T; clarsimp)
lemma LeftCond_single_Cond_const_red[simp, φsafe_simp]:
‹ T [True]∗ U = T ∗ U ›
by (rule φType_eqI, clarsimp)+
subsubsection ‹Conditional Insertion into Unital Algebra›
text ‹This section we give an equivalent representation ‹● T ∗ ◒[C] R› of the conditioned separation \<^term>‹T ∗[C] R›.
‹◒› is convenient to specify element-wise existence, and makes it easy to merge two conditioned remainders
‹ (fst a, wy) ⦂ A ∗[Cy] WY 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ Y ∗[Cb] B 𝗐𝗂𝗍𝗁 P1
⟹ (snd b, wx) ⦂ ◒[Cb] B ∗ ◒[Cx] WX 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 c ⦂ ● X ∗ ◒[Cr] R 𝗐𝗂𝗍𝗁 P2
⟹ (snd a ⦂ ◒[Cw] W) = ((wy, wx) ⦂ ◒[Cy] WY ∗ ◒[Cx] WX) @tag 𝒜merge
⟹ a ⦂ A ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ((fst b, fst c), snd c) ⦂ (Y ∗ X) ∗[Cr] R 𝗐𝗂𝗍𝗁 (P1 ∧ P2) ›
By ‹◒›, we can easily merge the two remainders of the transformation two-side. However, using ‹T ∗[C] U›
is not as easy as this.
Nonetheless, ‹T ∗[C] R› is suitable for the one-to-one transformation with remainders.
›
definition φCond_Unital_Ins :: ‹bool ⇒ ('v, 'x) φ ⇒ ('v option, 'x) φ› ("◒[_] _" [20,91] 90)
where ‹◒[C] T = (if C then ● T else ○⇩𝗑)›
definition Cond_Unital_Ins_BI :: ‹bool ⇒ 'c BI ⇒ 'c option BI› ("◒⇩B⇩I[_] _" [20,91] 90)
where ‹◒⇩B⇩I[C] A = (if C then Ψ[Some] A else 1)›
paragraph ‹Rewrites›
lemma Cond_Unital_Ins_BI_φType[no_atp]:
‹ ◒⇩B⇩I[C] (x ⦂ T) ≡ x ⦂ ◒[C] T ›
unfolding φCond_Unital_Ins_def Cond_Unital_Ins_BI_def atomize_eq BI_eq_iff
by clarsimp
lemma φCond_Unital_Ins_unfold[no_atp]:
‹ ◒[C] T = (if C then ● T else ○⇩𝗑) ›
unfolding φType_def φCond_Unital_Ins_def
by clarsimp
lemma φCond_Unital_Ins_unfold_simp[simp, φsafe_simp]:
‹ ◒[True] T ≡ ● T ›
‹ ◒[False] T ≡ ○⇩𝗑 ›
unfolding φCond_Unital_Ins_unfold
by simp+
lemma φCond_Unital_Ins_BI_unfold_simp[simp, φsafe_simp]:
‹ ◒⇩B⇩I[False] A ≡ 1 ›
unfolding Cond_Unital_Ins_BI_def
by simp
lemma φCond_Unital_Ins_expn[simp, φexpns]:
‹ p ⊨ (x ⦂ ◒[C] T) ⟷ (if C then (∃v. p = Some v ∧ v ⊨ (x ⦂ T)) else p = None) ›
unfolding φCond_Unital_Ins_unfold
by clarsimp
lemma φCond_Unital_BI_Ins_expn[simp, φexpns]:
‹ p ⊨ (◒⇩B⇩I[C] A) ⟷ (if C then (∃v. p = Some v ∧ v ⊨ A) else p = None) ›
unfolding Cond_Unital_Ins_BI_def
by clarsimp
lemma φCond_Unital_Prod:
‹◒[C] T ∗ ◒[C] U ≡ ◒[C] (T ∗ U)›
unfolding atomize_eq
by (rule φType_eqI; clarsimp; force)
lemma φCond_Unital_BI_Prod:
‹◒⇩B⇩I[C] A * ◒⇩B⇩I[C] B ≡ ◒⇩B⇩I[C] (A * B)›
unfolding atomize_eq BI_eq_iff
by (clarsimp; force)
lemma φCond_Unital_trans_rewr:
‹ x ⦂ ◒[C] T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[C] U 𝗐𝗂𝗍𝗁 C ⟶ P ≡ C ⟶ (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 P) ›
unfolding atomize_eq Transformation_def
by (cases C; clarsimp; blast)
lemma Cond_φProd_expn_φSome:
‹● (T ∗[C] U) ≡ ● T ∗ ◒[C] U›
unfolding atomize_eq
by (rule φType_eqI; cases C; clarsimp; force)
lemma Cond_φProd_expn_Cond_φProd:
‹◒[C⇩1] (T ∗[C⇩2] U) ≡ ◒[C⇩1] T ∗ ◒[C⇩1 ∧ C⇩2] U›
unfolding atomize_eq
by (rule φType_eqI; cases C⇩1; cases C⇩2; clarsimp; force)
lemma LCond_φProd_expn_φSome:
‹ ● (T [C]∗ U) ≡ ◒[C] T ∗ ● U ›
unfolding atomize_eq
by (rule φType_eqI; cases C; clarsimp; force)
lemma cond_prod_transformation_rewr:
‹ x ⦂ T ∗[C] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y' ⦂ U' 𝗐𝗂𝗍𝗁 P ≡ x ⦂ ● T ∗ ◒[C] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y' ⦂ ● U' 𝗐𝗂𝗍𝗁 P›
‹ x' ⦂ T' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[C] R 𝗐𝗂𝗍𝗁 P ≡ x' ⦂ ● T' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ● U ∗ ◒[C] R 𝗐𝗂𝗍𝗁 P›
unfolding atomize_eq
by (cases C; clarsimp simp add: φSome_φProd φSome_φNone_freeobj φSome_transformation_strip)+
lemma φCond_Unital_BI_eq_strip:
‹ ◒⇩B⇩I[True] A = ◒⇩B⇩I[True] B ≡ A = B ›
unfolding atomize_eq BI_eq_iff
by clarsimp blast
paragraph ‹Reasoning Properties›
lemma [φreason 1000]:
‹ (⋀x. x ⦂ T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P x)
⟹ x ⦂ ◒[C] T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 C ⟶ P x›
unfolding 𝗋EIF_def Satisfiable_def
by clarsimp blast
paragraph ‹Transformations›
lemma [φreason %ToA_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 P)
⟹ x ⦂ ◒[C] T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[C] U 𝗐𝗂𝗍𝗁 C ⟶ P›
unfolding Premise_def
by (simp add: φCond_Unital_trans_rewr)
lemma [φreason %ToA_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[Cr] R 𝗐𝗂𝗍𝗁 P)
⟹ x ⦂ ◒[C] T ∗[Cw] ◒[C] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[C] U ∗[Cr] ◒[C] R 𝗐𝗂𝗍𝗁 C ⟶ P›
unfolding Premise_def
by (cases Cw; cases Cr; clarsimp simp add: φCond_Unital_Prod φCond_Unital_trans_rewr)
paragraph ‹Normalization›
subparagraph ‹Source›
lemma [φreason %ToA_red]:
‹ x ⦂ ● T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ ◒[True] T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ 1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ ◒[False] T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ (x ⦂ ● T) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (x ⦂ ◒[True] T) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (x ⦂ ◒[False] T) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ x ⦂ ● T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ ◒[True] T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_success]:
‹ x ⦂ (◒[False] T ∗[True] U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (snd x, unspec) ⦂ (U ∗[False] ⊤⇩φ) ›
unfolding Action_Tag_def
by (cases x; simp add: φProd_expn')
subparagraph ‹Target›
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ● U 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[True] U 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[False] U 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ● U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[True] U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[False] U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ● U ∗[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ ◒[True] U ∗[C] R 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_success]:
‹ May_Assign (snd x) unspec
⟹ x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (unspec, fst x) ⦂ ◒[False] U ∗[True] T ›
by (clarsimp simp add: φSome_φNone_freeobj)
subsubsection ‹Conditional Item on Unital Algebra›
abbreviation φCond_Item :: ‹bool ⇒ 'v BI ⇒ 'v::one BI› ("◒⇩𝟭[_] _" [20,91] 90)
where ‹◒⇩𝟭[C] A ≡ (if C then A else 1)›
paragraph ‹Rewrites›
lemma φCond_Item_simp[simp, φsafe_simp]:
‹ ◒⇩𝟭[True] A ≡ A ›
‹ ◒⇩𝟭[False] A ≡ 1 ›
by simp+
lemma Remains_φCond_Item:
‹ (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) = A * ◒⇩𝟭[C] R ›
for A :: ‹'c::sep_magma_1 BI›
unfolding REMAINS_def
by (cases C; simp)
subsubsection ‹Bi-Conditioned Product›
definition BiCond_φProd :: ‹ ('v,'x) φ ⇒ bool ⇒ bool ⇒ ('v,'y) φ ⇒ ('v::sep_magma,'x × 'y) φ › ("_ [_]∗[_] _" [71,20,20,71] 70)
where ‹(T [C⇩T]∗[C⇩U] U) ≡ if C⇩T then if C⇩U then T ∗ U else (λx. fst x ⦂ T) else if C⇩U then (λx. snd x ⦂ U) else (λ_. ⊤)›
lemma BiCond_φProd_expn[φexpns, simp]:
‹ c ⊨ (x ⦂ T [C⇩T]∗[C⇩U] U) ⟷ (if C⇩T then if C⇩U then c ⊨ (x ⦂ T ∗ U) else c ⊨ (fst x ⦂ T) else if C⇩U then c ⊨ (snd x ⦂ U) else True)›
unfolding BiCond_φProd_def φType_def
by (cases C⇩T; cases C⇩U; clarsimp)
lemma BiCond_single_Cond_const_red[simp, φsafe_simp]:
‹ (x ⦂ T [False]∗[True] U) = (snd x ⦂ U)›
‹ T [True]∗[C] U = T ∗[C] U ›
‹ T [False]∗[False] U = ⊤⇩φ ›
by ((cases x, simp add: BI_eq_iff),
(rule φType_eqI, clarsimp)+)
lemma BiCond_single_Cond_rewrite:
‹ (x ⦂ T ∗[C⇩U ∨ C⇩W] (U [C⇩U]∗[C⇩W] W)) = (prod.rotL x ⦂ (T ∗[C⇩U] U) ∗[C⇩W] W)›
for T :: ‹('c::sep_semigroup,'a) φ›
by ((clarsimp simp add: BI_eq_iff; rule; clarsimp),
metis sep_disj_multD1 sep_disj_multI1 sep_mult_assoc',
metis sep_disj_multD2 sep_disj_multI2 sep_mult_assoc')
lemma BiCond_assoc:
‹ (x ⦂ (T⇩1 [C⇩1]∗[C⇩2] T⇩2) [C⇩1 ∨ C⇩2]∗[C⇩3] T⇩3) = (prod.rotR x ⦂ T⇩1 [C⇩1]∗[C⇩2 ∨ C⇩3] (T⇩2 [C⇩2]∗[C⇩3] T⇩3))›
for T⇩1 :: ‹('c::sep_semigroup,'a) φ›
unfolding BI_eq_iff
by ((cases x; cases C⇩1; cases C⇩2; cases C⇩3; clarsimp; rule; clarsimp),
metis sep_disj_multD2 sep_disj_multI2 sep_mult_assoc',
metis sep_disj_multD1 sep_disj_multI1 sep_mult_assoc')
lemma BiCond_assoc':
‹ (x ⦂ T⇩0 ∗[C⇩1 ∨ C⇩2 ∨ C⇩3] ((T⇩1 [C⇩1]∗[C⇩2] T⇩2) [C⇩1 ∨ C⇩2]∗[C⇩3] T⇩3)) = (apsnd prod.rotR x ⦂ T⇩0 ∗[C⇩1 ∨ C⇩2 ∨ C⇩3] (T⇩1 [C⇩1]∗[C⇩2 ∨ C⇩3] (T⇩2 [C⇩2]∗[C⇩3] T⇩3))) ›
for T⇩0 :: ‹('c::sep_semigroup,'a) φ›
unfolding BI_eq_iff
by ((cases x; cases C⇩1; cases C⇩2; cases C⇩3; clarsimp; rule; clarsimp),
metis sep_disj_multD2 sep_disj_multI2 sep_mult_assoc',
metis sep_disj_multD1 sep_disj_multI1 sep_mult_assoc')
lemma BiCond_expn_φSome:
‹ C⇩1 ∨ C⇩2
⟹ ● (T [C⇩1]∗[C⇩2] U) ≡ ◒[C⇩1] T ∗ ◒[C⇩2] U›
unfolding atomize_eq
by ((rule φType_eqI; cases C⇩1; cases C⇩2; clarsimp; rule; clarsimp),
metis sep_disj_option(1) times_option(1),
blast)
lemma BiCond_expn_BiCond:
‹ C ⟶ C⇩1 ∨ C⇩2
⟹ ◒[C] (T [C⇩1]∗[C⇩2] U) ≡ ◒[C ∧ C⇩1] T ∗ ◒[C ∧ C⇩2] U ›
unfolding atomize_eq
by ((rule φType_eqI; cases C; cases C⇩1; cases C⇩2; clarsimp; rule; clarsimp),
metis sep_disj_option(1) times_option(1),
blast)
paragraph ‹Syntax›
text ‹
‹U⇩0 [C⇩0]∗[C⇩1,C⇩2,…] (U⇩1,U⇩2,…) := U⇩0 [C⇩0]∗[C⇩1 ∨ C⇩2 ∨ …] (U⇩1 [C⇩1]∗[C⇩2 ∨ C⇩3 ∨ …] (U⇩2 [C⇩2]∗[C⇩3 ∨ …] …)) ›
is self-similar, where a pattern of ‹U⇩0 [C⇩0]∗[C⇩1,…,C⇩n] (U⇩1,…,U⇩n)› matches any structure
‹U⇩0 [C⇩0]∗[C⇩1,…,C⇩m] (U⇩1,…,U⇩m)› for ‹m ≥ n›.
‹T ∗[C⇩0,…,C⇩n] (U⇩0,…,U⇩n) := T ∗[C⇩0 ∨ … ∨ C⇩0] (U⇩0 [C⇩0]∗[C⇩1,…,C⇩n] (U⇩1,…,U⇩n))›
›
no_notation Cond_φProd ("_ ∗[_]/ _" [71,20,70] 70)
and BiCond_φProd ("_ [_]∗[_] _" [71,20,20,71] 70)
and LeftCond_φProd ("_ [_]∗ _" [69,20,70] 68)
syntax "_Cond_φProds" :: ‹logic ⇒ tuple_args ⇒ logic ⇒ logic› ("_ ∗[_]/ _" [71,20,71] 70)
"_BiCond_φProds" :: ‹logic ⇒ logic ⇒ tuple_args ⇒ logic ⇒ logic› ("_ [_]∗[_]/ _" [71,20,20,71] 70)
"_LCond_φProds" :: ‹logic ⇒ tuple_args ⇒ logic ⇒ logic› ("_ [_]∗/ _" [69,20,70] 68)
parse_translation ‹
let fun parse is_left (A, Ac, Cs, B) =
let fun strip_tuple (Const(\<^syntax_const>‹_tuple_args›, _) $ C $ Cs) = C :: strip_tuple Cs
| strip_tuple (Const(\<^syntax_const>‹_tuple_arg›, _) $ C) = [C]
fun strip_pair (Const(\<^const_syntax>‹Pair›, _) $ B $ Bs) = B :: strip_pair Bs
| strip_pair X = [X]
val Bs = strip_pair B |> is_left ? rev
val Cs = strip_tuple Cs |> is_left ? rev
val _ = if length Bs = length Cs then ()
else error "Bad Syntax: Unbalanced length of ‹_ ∗[_,_,this] (_,_,and,this)›"
fun mkL A _ [] [] = A
| mkL A Ac [B] [C] = Const(\<^const_name>‹BiCond_φProd›, dummyT) $ B $ C $ Ac $ A
| mkL A Ac (B::Bs) (C::Cs) =
Const(\<^const_name>‹BiCond_φProd›, dummyT)
$ (mkL B C Bs Cs)
$ foldr1 (fn (a,b) => HOLogic.mk_disj (b,a)) (C::Cs)
$ Ac
$ A
fun mk A _ [] [] = A
| mk A Ac [B] [C] = Const(\<^const_name>‹BiCond_φProd›, dummyT) $ A $ Ac $ C $ B
| mk A Ac (B::Bs) (C::Cs) =
Const(\<^const_name>‹BiCond_φProd›, dummyT) $ A
$ Ac
$ foldr1 HOLogic.mk_disj (C::Cs)
$ (mk B C Bs Cs)
in if is_left
then Const(\<^const_name>‹LeftCond_φProd›, dummyT)
$ mkL (hd Bs) (hd Cs) (tl Bs) (tl Cs)
$ foldl1 HOLogic.mk_disj (rev Cs)
$ A
else case Ac
of SOME Ac => mk A Ac Bs Cs
| _ => Const(\<^const_name>‹Cond_φProd›, dummyT) $ A
$ foldr1 HOLogic.mk_disj Cs
$ mk (hd Bs) (hd Cs) (tl Bs) (tl Cs)
end
in [(\<^syntax_const>‹_Cond_φProds›, fn _ => fn [A,Cs,B] => parse false (A,NONE,Cs,B)),
(\<^syntax_const>‹_BiCond_φProds›, fn _ => fn [A,Ac,Cs,B] => parse false (A,SOME Ac,Cs,B)),
(\<^syntax_const>‹_LCond_φProds›, fn _ => fn [A,Cs,B] => parse true (B,NONE,Cs,A))]
end›
print_translation ‹
let fun parseL (Const(\<^const_syntax>‹BiCond_φProd›, _)
$ (Us' as Const(\<^const_syntax>‹BiCond_φProd›, _) $ _ $ _ $ _ $ _)
$ (CUs' as Const(\<^const_syntax>‹HOL.disj›, _) $ _ $ _)
$ CT $ T) =
let fun strip_disj (Const(\<^const_syntax>‹HOL.disj›, _) $ Cs $ C) = C :: strip_disj Cs
| strip_disj C = [C]
val (Us, CUs) = parseL Us'
val myCUs = strip_disj CUs'
val _ = if eq_list Term.aconv_untyped (CUs, myCUs) then () else raise Match
in (T::Us, CT::CUs)
end
| parseL (Const(\<^const_syntax>‹BiCond_φProd›, _) $ U $ CU $ CT $ T) = ([T,U], [CT,CU])
fun parse (Const(\<^const_syntax>‹BiCond_φProd›, _) $ T $ CT
$ (CUs' as Const(\<^const_syntax>‹HOL.disj›, _) $ _ $ _)
$ (Us' as Const(\<^const_syntax>‹BiCond_φProd›, _) $ _ $ _ $ _ $ _)) =
let fun strip_disj (Const(\<^const_syntax>‹HOL.disj›, _) $ C $ Cs) = C :: strip_disj Cs
| strip_disj C = [C]
val (Us, CUs) = parse Us'
val myCUs = strip_disj CUs'
val _ = if eq_list Term.aconv_untyped (CUs, myCUs) then () else raise Match
in (T::Us, CT::CUs)
end
| parse (Const(\<^const_syntax>‹BiCond_φProd›, _) $ T $ CT $ CU $ U) = ([T,U], [CT,CU])
fun mk is_left (T::Us) (CT::CUs) =
let val head = (if pointer_eq (CT, Term.dummy_prop)
then if is_left then Const(\<^syntax_const>‹_LCond_φProds›, dummyT)
else Const(\<^syntax_const>‹_Cond_φProds›, dummyT) $ T
else Const(\<^syntax_const>‹_BiCond_φProds›, dummyT) $ T $ CT)
val CUs = case CUs
of [_] => hd CUs
| _ => foldl1 (fn (a,b) => Const(\<^syntax_const>‹_tuple_args›, dummyT) $ a $ b)
(if is_left then rev CUs else CUs)
val Us = case (if is_left then rev Us else Us)
of [_] => hd Us
| U::Uss =>
Const(\<^syntax_const>‹_tuple›, dummyT) $ U
$ foldl1 (fn (a,b) => Const(\<^syntax_const>‹_tuple_args›, dummyT) $ a $ b) Uss
in if is_left then head $ Us $ CUs $ T
else head $ CUs $ Us
end
fun print is_left (T',CT',CU',U') =
let val (Ts,Cs) = if is_left
then parseL (Const(\<^const_syntax>‹BiCond_φProd›, dummyT) $ T' $ CT' $ CU' $ U')
else parse (Const(\<^const_syntax>‹BiCond_φProd›, dummyT) $ T' $ CT' $ CU' $ U')
in mk is_left Ts Cs
end
in [(\<^const_syntax>‹BiCond_φProd›, fn _ => fn [T,CT,CU,U] => print false (T,CT,CU,U)),
(\<^const_syntax>‹Cond_φProd›, fn _ => fn [T,CU,U] => print false (T,Term.dummy_prop,CU,U)),
(\<^const_syntax>‹LeftCond_φProd›, fn _ => fn [T,CU,U] => print true (T,CU,Term.dummy_prop,U))]
end
›
subsubsection ‹Merging Conditioned φ-Types \& Assertions›
consts 𝒜merge :: action
declare [[φreason_default_pattern
‹(_ ⦂ ◒[_] _) = ((_,_) ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _) @tag 𝒜merge› ⇒
‹(_ ⦂ ◒[_] _) = (_ ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _) @tag 𝒜merge› (100)
and ‹(_ ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _) = (_ ⦂ ◒[_] _) @tag 𝒜merge› ⇒
‹(_ ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _) = (_ ⦂ ◒[_] _) @tag 𝒜merge› (100)
and ‹(_ ⦂ ◒[_] _) = ((_,_,_) ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _ ∗ ◒[?Cc] _) @tag 𝒜merge› ⇒
‹(_ ⦂ ◒[_] _) = (_ ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _ ∗ ◒[?Cc] _) @tag 𝒜merge› (100)
and ‹(_ ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _ ∗ ◒[?Cc] _) = (_ ⦂ ◒[_] _) @tag 𝒜merge› ⇒
‹(_ ⦂ ◒[?Ca] _ ∗ ◒[?Cb] _ ∗ ◒[?Cc] _) = (_ ⦂ ◒[_] _) @tag 𝒜merge› (100)
and ‹◒[_] _ = ◒[?C⇩A] _ ∗ ◒[?C⇩B] _ @tag 𝒜merge› ⇒
‹◒[_] _ = ◒[?C⇩A] _ ∗ ◒[?C⇩B] _ @tag 𝒜merge› (100)
and ‹◒[_] _ = ◒[?C⇩A] _ ∗ ◒[?C⇩B] _ ∗ ◒[?C⇩C] _ @tag 𝒜merge› ⇒
‹◒[_] _ = ◒[?C⇩A] _ ∗ ◒[?C⇩B] _ ∗ ◒[?C⇩C] _ @tag 𝒜merge› (100)
and ‹◒⇩B⇩I[_] _ = ◒⇩B⇩I[?C⇩A] _ * ◒⇩B⇩I[?C⇩B] _ @tag 𝒜merge› ⇒
‹◒⇩B⇩I[_] _ = ◒⇩B⇩I[?C⇩A] _ * ◒⇩B⇩I[?C⇩B] _ @tag 𝒜merge› (100)
and ‹?X @tag 𝒜merge› ⇒
‹ERROR TEXT(‹Malformed 𝒜merge rule› (?X @tag 𝒜merge))› (0)
]]
φreasoner_group 𝒜merge = (%cutting, [%cutting, %cutting+20]) for ‹(_ ⦂ ◒[_] _) = _›
‹Rules merging multiple conditioned φtypes into one conditioned φtype,
always using the abstract object(s) given in the left hand side to assign the abstract object(s)
in the right.›
text ‹Information is always given from left to right below.
They accept arguments from LHS and assign the result to RHS›
paragraph ‹Simplification Protects›
definition [simplification_protect]:
‹𝒜merge_SP P ≡ P @tag 𝒜merge›
lemma [cong]:
‹𝒜merge_SP P ≡ 𝒜merge_SP P› .
paragraph ‹Implementation›
lemma [φreason %𝒜merge+20 for ‹(fst (_,_) ⦂ _) = _ @tag 𝒜merge›]:
‹ (x ⦂ T) = Y @tag 𝒜merge
⟹ (fst (x,y) ⦂ T) = Y @tag 𝒜merge ›
by simp
lemma [φreason %𝒜merge+20 for ‹(snd (_,_) ⦂ _) = _ @tag 𝒜merge›]:
‹ (y ⦂ U) = Y @tag 𝒜merge
⟹ (snd (x,y) ⦂ U) = Y @tag 𝒜merge ›
by simp_all
lemma [φreason %𝒜merge+20 for ‹((_, snd _) ⦂ _) = _ @tag 𝒜merge›]:
‹ ((x, z) ⦂ U) = Y @tag 𝒜merge
⟹ ((x, snd (y,z)) ⦂ U) = Y @tag 𝒜merge ›
by simp_all
lemma [φreason %𝒜merge+20 for ‹((_, fst _) ⦂ _) = _ @tag 𝒜merge›]:
‹ ((x, y) ⦂ U) = Y @tag 𝒜merge
⟹ ((x, fst (y,z)) ⦂ U) = Y @tag 𝒜merge ›
by simp_all
lemma [φreason %𝒜merge]:
‹(x ⦂ ◒[True] (A ∗ B)) = ((fst x, snd x) ⦂ ◒[True] A ∗ ◒[True] B) @tag 𝒜merge›
‹(a ⦂ ◒[True] A) = ((a, unspec) ⦂ ◒[True] A ∗ ◒[False] B) @tag 𝒜merge›
‹(b ⦂ ◒[True] B) = ((unspec, b) ⦂ ◒[False] A ∗ ◒[True] B) @tag 𝒜merge›
‹(any ⦂ ◒[False] ⊤⇩φ) = ((unspec, unspec) ⦂ ◒[False] A ∗ ◒[False] B) @tag 𝒜merge›
unfolding Action_Tag_def BI_eq_iff
by (clarsimp; force)+
lemma [φreason %𝒜merge]:
‹ (x ⦂ ◒[True] A ∗ ◒[True] B) = (x ⦂ ◒[True] (A ∗ B)) @tag 𝒜merge ›
‹ (x ⦂ ◒[True] A ∗ ◒[False] B) = (fst x ⦂ ◒[True] A) @tag 𝒜merge ›
‹ (x ⦂ ◒[False] A ∗ ◒[True] B) = (snd x ⦂ ◒[True] B) @tag 𝒜merge ›
‹ (x ⦂ ◒[False] A ∗ ◒[False] B) = (unspec ⦂ ◒[False] ⊤⇩φ) @tag 𝒜merge ›
unfolding Action_Tag_def BI_eq_iff
by (clarsimp; force)+
lemma [φreason %𝒜merge+10]:
‹ ((x,y) ⦂ ◒[True] A ∗ ◒[False] B) = (x ⦂ ◒[True] A) @tag 𝒜merge ›
‹ ((x,y) ⦂ ◒[False] A ∗ ◒[True] B) = (y ⦂ ◒[True] B) @tag 𝒜merge ›
unfolding Action_Tag_def BI_eq_iff
by (clarsimp; force)+
lemma [φreason %𝒜merge]:
‹(x ⦂ ◒[True] T ∗ ◒[True] U ∗ ◒[True] R) = (x ⦂ ◒[True] (T ∗ U ∗ R)) @tag 𝒜merge›
‹(x ⦂ ◒[True] T ∗ ◒[True] U ∗ ◒[False] R) = ((fst x, fst (snd x)) ⦂ ◒[True] (T ∗ U)) @tag 𝒜merge›
‹(x ⦂ ◒[True] T ∗ ◒[False] U ∗ ◒[True] R) = ((fst x, snd (snd x)) ⦂ ◒[True] (T ∗ R)) @tag 𝒜merge›
‹(x ⦂ ◒[True] T ∗ ◒[False] U ∗ ◒[False] R) = (fst x ⦂ ◒[True] T) @tag 𝒜merge›
‹(x ⦂ ◒[False] T ∗ ◒[True] U ∗ ◒[True] R) = ((fst (snd x), snd (snd x)) ⦂ ◒[True] (U ∗ R)) @tag 𝒜merge›
‹(x ⦂ ◒[False] T ∗ ◒[True] U ∗ ◒[False] R) = (fst (snd x) ⦂ ◒[True] U) @tag 𝒜merge›
‹(x ⦂ ◒[False] T ∗ ◒[False] U ∗ ◒[True] R) = (snd (snd x) ⦂ ◒[True] R) @tag 𝒜merge›
‹(x ⦂ ◒[False] T ∗ ◒[False] U ∗ ◒[False] R) = (unspec ⦂ ◒[False] ⊤⇩φ) @tag 𝒜merge›
unfolding Action_Tag_def
by (cases x, clarsimp simp add: φSome_φNone_freeobj φProd_expn' φProd_expn'' φSome_φProd[symmetric])+
lemma [φreason %𝒜merge+5]:
‹((x,y) ⦂ ◒[True] T ∗ ◒[True] U ∗ ◒[False] R) = ((x, fst y) ⦂ ◒[True] (T ∗ U)) @tag 𝒜merge›
‹((x,y) ⦂ ◒[True] T ∗ ◒[False] U ∗ ◒[True] R) = ((x, snd y) ⦂ ◒[True] (T ∗ R)) @tag 𝒜merge›
‹((x,y) ⦂ ◒[True] T ∗ ◒[False] U ∗ ◒[False] R) = (x ⦂ ◒[True] T) @tag 𝒜merge›
‹((x,y) ⦂ ◒[False] T ∗ ◒[True] U ∗ ◒[True] R) = (y ⦂ ◒[True] (U ∗ R)) @tag 𝒜merge›
‹((x,y) ⦂ ◒[False] T ∗ ◒[True] U ∗ ◒[False] R) = (fst y ⦂ ◒[True] U) @tag 𝒜merge›
‹((x,y) ⦂ ◒[False] T ∗ ◒[False] U ∗ ◒[True] R) = (snd y ⦂ ◒[True] R) @tag 𝒜merge›
unfolding Action_Tag_def
by (cases y, clarsimp simp add: φSome_φNone_freeobj φProd_expn' φProd_expn'' φSome_φProd[symmetric])+
lemma [φreason %𝒜merge+10]:
‹((x,y,z) ⦂ ◒[True] T ∗ ◒[True] U ∗ ◒[False] R) = ((x,y) ⦂ ◒[True] (T ∗ U)) @tag 𝒜merge›
‹((x,y,z) ⦂ ◒[True] T ∗ ◒[False] U ∗ ◒[True] R) = ((x,z) ⦂ ◒[True] (T ∗ R)) @tag 𝒜merge›
‹((x,y,z) ⦂ ◒[False] T ∗ ◒[True] U ∗ ◒[False] R) = (y ⦂ ◒[True] U) @tag 𝒜merge›
‹((x,y,z) ⦂ ◒[False] T ∗ ◒[False] U ∗ ◒[True] R) = (z ⦂ ◒[True] R) @tag 𝒜merge›
unfolding Action_Tag_def
by(clarsimp simp add: φSome_φNone_freeobj φProd_expn' φProd_expn'' φSome_φProd[symmetric])+
lemma [φreason %𝒜merge]:
‹(x1 ⦂ ◒[True] (T ∗ U ∗ R)) = ((fst x1, fst (snd x1), snd (snd x1)) ⦂ ◒[True] T ∗ ◒[True] U ∗ ◒[True] R) @tag 𝒜merge›
‹(x2 ⦂ ◒[True] (T ∗ U)) = ((fst x2, snd x2, unspec) ⦂ ◒[True] T ∗ ◒[True] U ∗ ◒[False] R) @tag 𝒜merge›
‹(x3 ⦂ ◒[True] (T ∗ R)) = ((fst x3, unspec, snd x3) ⦂ ◒[True] T ∗ ◒[False] U ∗ ◒[True] R) @tag 𝒜merge›
‹(x4 ⦂ ◒[True] T) = ((x4, unspec, unspec) ⦂ ◒[True] T ∗ ◒[False] U ∗ ◒[False] R) @tag 𝒜merge›
‹(x5 ⦂ ◒[True] (U ∗ R)) = ((unspec, fst x5, snd x5) ⦂ ◒[False] T ∗ ◒[True] U ∗ ◒[True] R) @tag 𝒜merge›
‹(x6 ⦂ ◒[True] U) = ((unspec, x6, unspec) ⦂ ◒[False] T ∗ ◒[True] U ∗ ◒[False] R) @tag 𝒜merge›
‹(x7 ⦂ ◒[True] R) = ((unspec, unspec, x7) ⦂ ◒[False] T ∗ ◒[False] U ∗ ◒[True] R) @tag 𝒜merge›
‹(unspec ⦂ ◒[False] ⊤⇩φ) = ((unspec, unspec, unspec) ⦂ ◒[False] T ∗ ◒[False] U ∗ ◒[False] R) @tag 𝒜merge›
unfolding Action_Tag_def
by (clarsimp simp add: φSome_φProd[symmetric] φProd_expn' φProd_expn'' φSome_φNone_freeobj)+
paragraph ‹Merging Conditioned BI Assertion›
lemma [φreason %𝒜merge]:
‹ ◒⇩B⇩I[True] (A * B) = (◒⇩B⇩I[True] A) * (◒⇩B⇩I[True] B) @tag 𝒜merge ›
‹ ◒⇩B⇩I[True] A = (◒⇩B⇩I[True] A) * (◒⇩B⇩I[False] B) @tag 𝒜merge ›
‹ ◒⇩B⇩I[True] B = (◒⇩B⇩I[False] A) * (◒⇩B⇩I[True] B) @tag 𝒜merge ›
‹ ◒⇩B⇩I[False] ⊤ = (◒⇩B⇩I[False] A) * (◒⇩B⇩I[False] B) @tag 𝒜merge ›
unfolding Action_Tag_def BI_eq_iff
by (clarsimp; force)+
lemma [φreason %𝒜merge]:
‹ ◒[True] (A ∗ B) = ◒[True] A ∗ ◒[True] B @tag 𝒜merge ›
‹ ◒[True] (A ∗[False] ⊤⇩φ) = ◒[True] A ∗ ◒[False] B @tag 𝒜merge ›
‹ ◒[True] (⊤⇩φ [False]∗ B) = ◒[False] A ∗ ◒[True] B @tag 𝒜merge ›
‹ ◒[False] ⊤⇩φ = ◒[False] A ∗ ◒[False] B @tag 𝒜merge ›
unfolding Action_Tag_def
by (rule φType_eqI_BI; clarsimp simp add: BI_eq_iff; force)+
lemma [φreason %𝒜merge]:
‹ ◒[True] (A ∗ B ∗ C) = ◒[True] A ∗ ◒[True] B ∗ ◒[True] C @tag 𝒜merge ›
‹ ◒[True] (A ∗[False] ⊤⇩φ) = ◒[True] A ∗ ◒[False] B ∗ ◒[False] C @tag 𝒜merge ›
‹ ◒[True] (A ∗ B ∗[False] ⊤⇩φ) = ◒[True] A ∗ ◒[True] B ∗ ◒[False] C @tag 𝒜merge ›
‹ ◒[True] (A ∗ (⊤⇩φ [False]∗ C)) = ◒[True] A ∗ ◒[False] B ∗ ◒[True] C @tag 𝒜merge ›
‹ ◒[True] (⊤⇩φ [False]∗ B ∗ C) = ◒[False] A ∗ ◒[True] B ∗ ◒[True] C @tag 𝒜merge ›
‹ ◒[True] (⊤⇩φ [False]∗ (⊤⇩φ [False]∗ C)) = ◒[False] A ∗ ◒[False] B ∗ ◒[True] C @tag 𝒜merge ›
‹ ◒[True] (⊤⇩φ [False]∗ (B ∗[False] ⊤⇩φ)) = ◒[False] A ∗ ◒[True] B ∗ ◒[False] C @tag 𝒜merge ›
‹ ◒[False] ⊤⇩φ = ◒[False] A ∗ ◒[False] B ∗ ◒[False] C @tag 𝒜merge ›
unfolding Action_Tag_def
by (rule φType_eqI_BI; clarsimp simp add: BI_eq_iff; force)+
paragraph ‹Nested Merging›
lemma [φreason %𝒜merge for ‹◒[_] _ = ◒[_] _ ∗ ◒[_ ∨ _] (_ [_]∗[_] _) @tag 𝒜merge›]:
‹ ◒[C⇩Y] Y = ◒[C⇩B] B ∗ ◒[C⇩C] C @tag 𝒜merge
⟹ ◒[C⇩X] X = ◒[C⇩A] A ∗ ◒[C⇩Y] Y @tag 𝒜merge
⟹ ◒[C⇩X] X = ◒[C⇩A] A ∗ ◒[C⇩B ∨ C⇩C] (B [C⇩B]∗[C⇩C] C) @tag 𝒜merge ›
unfolding Action_Tag_def
by (clarsimp simp: BiCond_expn_BiCond; cases C⇩A; cases C⇩B; cases C⇩C; simp)
subsubsection ‹Separation Extraction of ‹φ›Prod›
text ‹Using the technical auxiliaries, we can give the separation extraction for ‹φProd››
lemma [φreason %ToA_cut]:
‹ (fst a, wy) ⦂ A ∗[Cy] WY 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ Y ∗[Cb] B 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫'
⟹ if Cb then ((snd b, wx) ⦂ B ∗[Cx] WX 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 c ⦂ X ∗[Cr] R 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫')
else (Cx, Cr, WX, c, P2) = (True, False, X, (wx, unspec), True)
⟹ (snd a ⦂ ◒[Cw] W) = ((wy, wx) ⦂ ◒[Cy] WY ∗ ◒[Cx] WX) @tag 𝒜merge
⟹ a ⦂ A ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ((fst b, fst c), snd c) ⦂ (Y ∗ X) ∗[Cr] R 𝗐𝗂𝗍𝗁 (P1 ∧ P2) @tag 𝒯𝒫'›
for A :: ‹('a::sep_semigroup,'b) φ›
unfolding Action_Tag_def Try_def
apply (cases Cb; simp add: cond_prod_transformation_rewr;
clarsimp simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] Cond_φProd_expn_φSome)
subgoal premises prems
by (insert prems(1)[THEN transformation_right_frame, where R=‹wx ⦂ ◒[Cx] WX›]
prems(2)[THEN transformation_left_frame, where R=‹fst b ⦂ ● Y›],
simp add: mult.assoc transformation_trans)
by (metis (no_types, lifting) mult.assoc transformation_right_frame)
lemma [φreason %ToA_cut]:
‹ (fst (fst x), fst wr) ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 yr ⦂ Y ∗[Cra] Rt 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫'
⟹ if Cw then ((snd (fst x), snd x) ⦂ U ∗[Cw2] W2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 wr ⦂ W ∗[Crb] Ru 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫')
else (Cw2, Crb, Ru, wr, P2) = (False, True, U, (unspec, snd (fst x)), True)
⟹ ((snd yr, snd wr) ⦂ ◒[Cra] Rt ∗ ◒[Crb] Ru) = (r ⦂ ◒[Cr] R) @tag 𝒜merge
⟹ x ⦂ (T ∗ U) ∗[Cw2] W2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst yr, r) ⦂ Y ∗[Cr] R 𝗐𝗂𝗍𝗁 P1 ∧ P2 @tag 𝒯𝒫' ›
for T :: ‹('a::sep_semigroup,'b) φ›
unfolding Action_Tag_def Try_def
apply (cases Cw; simp add: cond_prod_transformation_rewr;
simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] Cond_φProd_expn_φSome)
subgoal premises prems
by (insert prems(1)[THEN transformation_right_frame, where R=‹snd wr ⦂ ◒[Crb] Ru›]
prems(2)[THEN transformation_left_frame, where R=‹fst (fst x) ⦂ ● T›],
simp add: mult.assoc[symmetric] prems(3)[symmetric],
smt (z3) Transformation_def)
by (metis (no_types, lifting) mult.assoc transformation_right_frame)
section ‹Basic φ-Type Properties›
text ‹The two properties are essential for reasoning the general transformation including separation extraction.›
subsection ‹Identity Element I\&E›
definition Identity_Element⇩I :: ‹'a::one BI ⇒ bool ⇒ bool› where ‹Identity_Element⇩I S P ⟷ (S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗐𝗂𝗍𝗁 P)›
definition Identity_Element⇩E :: ‹'a::one BI ⇒ bool› where ‹Identity_Element⇩E S ⟷ (1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S)›
definition Identity_Elements⇩I :: ‹('c::one,'a) φ ⇒ ('a ⇒ bool) ⇒ ('a ⇒ bool) ⇒ bool›
where ‹Identity_Elements⇩I T D P ⟷ (∀x. D x ⟶ Identity_Element⇩I (x ⦂ T) (P x))›
definition Identity_Elements⇩E :: ‹('c::one,'a) φ ⇒ ('a ⇒ bool) ⇒ bool›
where ‹Identity_Elements⇩E T D ⟷ (∀x. D x ⟶ Identity_Element⇩E (x ⦂ T))›
definition Identity_Elements :: ‹('c::one,'a) φ ⇒ ('a ⇒ bool) ⇒ bool›
where ‹Identity_Elements T D ⟷ Identity_Elements⇩I T D (λ_. True) ∧ Identity_Elements⇩E T D›
lemma Identity_Elements_alt_def:
‹Identity_Elements T D ⟷ (∀x. D x ⟶ (x ⦂ T) = 1)›
unfolding Identity_Elements_def Identity_Elements⇩I_def Identity_Element⇩I_def
Identity_Elements⇩E_def Identity_Element⇩E_def BI_eq_ToA
by (rule; clarsimp)
definition Hint_Identity_Element :: ‹('c::one,'a) φ ⇒ 'a ⇒ bool›
where ‹Hint_Identity_Element T one ≡ True›
declare [[ φreason_default_pattern
‹Identity_Element⇩I ?S _› ⇒ ‹Identity_Element⇩I ?S _› (100)
and ‹Identity_Element⇩I (_ ⦂ ?T) _› ⇒ ‹Identity_Element⇩I (_ ⦂ ?T) _› (110)
and ‹Identity_Element⇩E ?S› ⇒ ‹Identity_Element⇩E ?S› (100)
and ‹Identity_Element⇩E (_ ⦂ ?T)› ⇒ ‹Identity_Element⇩E (_ ⦂ ?T)› (110)
and ‹Identity_Elements⇩I ?T _ _› ⇒ ‹Identity_Elements⇩I ?T _ _› (100)
and ‹Identity_Elements⇩E ?T _› ⇒ ‹Identity_Elements⇩E ?T _› (100)
and ‹Hint_Identity_Element ?T _› ⇒ ‹Hint_Identity_Element ?T _› (100)
and ‹Identity_Elements ?T _› ⇒ ‹Identity_Elements ?T _› (100)
]]
φreasoner_group identity_element = (100,[1,3000]) for (‹Identity_Element⇩I _ _›, ‹Identity_Element⇩E _›)
‹Reasoning rules deducing if the given assertion can transform to or be transformed from the
assertion of identity element.›
and identity_element_fallback = (1,[1,1]) for (‹Identity_Element⇩I _ _›, ‹Identity_Element⇩E _›)
in identity_element > fail
‹Fallbacks of reasoning Identity_Element.›
and identity_element_φ = (10, [10, 11]) for (‹Identity_Element⇩I _ _›, ‹Identity_Element⇩E _›)
‹Turning to ‹Identity_Elements⇩I› and ‹Identity_Elements⇩E››
and derived_identity_element = (50, [50,55]) for (‹Identity_Element⇩I _ _›, ‹Identity_Element⇩E _›)
in identity_element > identity_element_φ
‹Automatically derived Identity_Element rules›
and identity_element_top = (2900, [2900,2999]) in identity_element ‹top›
and identity_element_cut = (1000, [1000,1029]) for (‹Identity_Element⇩I _ _›, ‹Identity_Element⇩E _›)
in identity_element > derived_identity_element < identity_element_top
‹Cutting rules for Identity_Element›
and identity_element_OPEN_MAKE = (1100, [1100,1100]) in identity_element
and > identity_element_cut < identity_element_top ‹›
and identity_element_red = (2500, [2500, 2530]) for (‹Identity_Element⇩I _ _›, ‹Identity_Element⇩E _›)
in identity_element > identity_element_cut
‹Literal Reduction›
and identity_element_ToA = (50, [50,51]) for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _› in ToA
‹Entry points from ToA to Identity_Element›
and identity_element_hint = (1000, [10, 2000]) for ‹Hint_Identity_Element T ie›
‹syntactical hints suggesting an identity element of the given φ-type›
subsubsection ‹Extracting Pure Facts›
paragraph ‹Identity_Element›
lemma [φreason %extract_pure]:
‹ 𝗋ESC Q (Satisfiable S)
⟹ 𝗋EIF (Identity_Element⇩I S P) (Q ⟶ P) ›
unfolding Identity_Element⇩I_def 𝗋ESC_def 𝗋EIF_def Transformation_def Satisfiable_def
by blast
lemma [φreason %extract_pure]:
‹ 𝗋EIF (Satisfiable S) P
⟹ 𝗋EIF (Identity_Element⇩E S) P ›
unfolding Identity_Element⇩E_def 𝗋ESC_def 𝗋EIF_def Transformation_def Satisfiable_def
by blast
lemma Identity_Element⇩I_𝒜EIF_sat:
‹ 𝗋EIF (Identity_Element⇩I S P) (∀v. v ⊨ S ⟶ v = 1 ∧ P) ›
unfolding Identity_Element⇩I_def 𝗋EIF_def Transformation_def
by blast
lemma Identity_Element⇩I_𝒜ESC_sat:
‹ 𝗋ESC (∀v. v ⊨ S ⟶ v = 1 ∧ P) (Identity_Element⇩I S P) ›
unfolding Identity_Element⇩I_def 𝗋ESC_def Transformation_def
by blast
lemma Identity_Element⇩E_𝒜EIF_sat:
‹ 𝗋EIF (Identity_Element⇩E S) (1 ⊨ S) ›
unfolding Identity_Element⇩E_def 𝗋EIF_def Transformation_def
by blast
lemma Identity_Element⇩E_𝒜ESC_sat:
‹ 𝗋ESC (1 ⊨ S) (Identity_Element⇩E S) ›
unfolding Identity_Element⇩E_def 𝗋ESC_def Transformation_def
by blast
bundle Identity_Element⇩I_sat = Identity_Element⇩I_𝒜EIF_sat [φreason %extract_pure_sat]
Identity_Element⇩I_𝒜ESC_sat [φreason %extract_pure_sat]
bundle Identity_Element⇩E_sat = Identity_Element⇩E_𝒜EIF_sat [φreason %extract_pure_sat]
Identity_Element⇩E_𝒜ESC_sat [φreason %extract_pure_sat]
bundle Identity_Element_sat begin
unbundle Identity_Element⇩I_sat Identity_Element⇩E_sat
end
paragraph ‹Identity_Elements›
lemma [φreason %extract_pure]:
‹ (⋀x. 𝗋EIF (Identity_Element⇩I (x ⦂ T) (P x)) (Q x))
⟹ 𝗋EIF (Identity_Elements⇩I T D P) (∀x. D x ⟶ Q x)›
unfolding 𝗋EIF_def Identity_Elements⇩I_def
by clarsimp
lemma [φreason %extract_pure]:
‹ (⋀x. 𝗋EIF (Identity_Element⇩E (x ⦂ T)) (Q x))
⟹ 𝗋EIF (Identity_Elements⇩E T D) (∀x. D x ⟶ Q x) ›
unfolding 𝗋EIF_def Identity_Elements⇩E_def
by clarsimp
subsubsection ‹System Rules›
lemma Identity_Elements⇩I_sub:
‹ D' ≤ D
⟹ P ≤ P'
⟹ Identity_Elements⇩I T D P
⟹ Identity_Elements⇩I T D' P' ›
unfolding Identity_Elements⇩I_def Identity_Element⇩I_def Transformation_def
by (clarsimp simp add: le_fun_def; blast)
lemma [φreason %cutting]:
‹ Identity_Elements⇩I T D⇩I P
⟹ Identity_Elements⇩E T D⇩E
⟹ Identity_Elements T (λx. D⇩I x ∧ D⇩E x) ›
unfolding Identity_Elements_def
by (smt (verit, best) Identity_Elements⇩E_def Identity_Elements⇩I_sub predicate1I)
subsubsection ‹Fallback›
lemma [φreason default %fail]:
‹ TRACE_FAIL TEXT(‹Fail to show› (S 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1))
⟹ Identity_Element⇩I S Any ›
unfolding TRACE_FAIL_def
by blast
lemma [φreason default %fail]:
‹ TRACE_FAIL TEXT(‹Fail to show› (1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 S))
⟹ Identity_Element⇩E S ›
unfolding TRACE_FAIL_def
by blast
lemma [φreason default %identity_element_fallback]:
‹ Identity_Elements⇩I T (λ_. False) (λ_. True) ›
unfolding Identity_Elements⇩I_def
by blast
lemma [φreason default %identity_element_fallback]:
‹ Identity_Elements⇩E T (λ_. False) ›
unfolding Identity_Elements⇩E_def
by blast
subsubsection ‹Termination›
lemma [φreason %identity_element_cut]:
‹Identity_Element⇩I 0 True›
unfolding Identity_Element⇩I_def by simp
lemma [φreason %identity_element_cut for ‹Identity_Element⇩E 1›
‹Identity_Element⇩E ?var› ]:
‹Identity_Element⇩E 1›
unfolding Identity_Element⇩E_def by simp
lemma [φreason %identity_element_cut for ‹Identity_Element⇩I 1 _›
‹Identity_Element⇩I ?var _› ]:
‹Identity_Element⇩I 1 True›
unfolding Identity_Element⇩I_def by simp
lemma Identity_Element⇩E_empty[φreason %identity_element_cut]:
‹Identity_Element⇩E (any ⦂ ○)›
unfolding Identity_Element⇩E_def by simp
lemma Identity_Element⇩I_empty[φreason %identity_element_cut]:
‹Identity_Element⇩I (any ⦂ ○) True›
unfolding Identity_Element⇩I_def by simp
lemma [φreason %identity_element_cut]:
‹Identity_Element⇩E (any ⦂ ○⇩𝗑)›
unfolding Identity_Element⇩E_def by simp
lemma [φreason %identity_element_cut]:
‹Identity_Element⇩I (any ⦂ ○⇩𝗑) True›
unfolding Identity_Element⇩I_def by simp
subsubsection ‹Special Forms›
lemma [φreason %identity_element_red for ‹Identity_Element⇩I _ True›]:
‹ Identity_Element⇩I X Any
⟹ Identity_Element⇩I X True ›
unfolding Identity_Element⇩I_def Transformation_def
by simp
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩I X P
⟹ Identity_Element⇩I (φTagA mode X) P ›
unfolding φTagA_def .
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E X
⟹ Identity_Element⇩E (φTagA mode X) ›
unfolding φTagA_def .
paragraph ‹Conditioned Branch›
subparagraph ‹Reduction›
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩I A P
⟹ Identity_Element⇩I (If True A B) P ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩I B P
⟹ Identity_Element⇩I (If False A B) P ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩E A
⟹ Identity_Element⇩E (If True A B) ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩E B
⟹ Identity_Element⇩E (If False A B) ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩I A D P
⟹ Identity_Elements⇩I (If True A B) D P ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩I B D P
⟹ Identity_Elements⇩I (If False A B) D P ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩E A D
⟹ Identity_Elements⇩E (If True A B) D ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩E B D
⟹ Identity_Elements⇩E (If False A B) D ›
by simp
subparagraph ‹Normalizing›
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩I (If C (x ⦂ A) (x ⦂ B)) P
⟹ Identity_Element⇩I (x ⦂ If C A B) P›
by (cases C; simp)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E (If C (x ⦂ A) (x ⦂ B))
⟹ Identity_Element⇩E (x ⦂ If C A B)›
by (cases C; simp)
subparagraph ‹Case Split›
lemma [φreason %identity_element_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Elements⇩I A D⇩A P⇩A)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬C ⟹ Identity_Elements⇩I B D⇩B P⇩B)
⟹ Identity_Elements⇩I (If C A B) (if C then D⇩A else D⇩B) (if C then P⇩A else P⇩B) ›
by (cases C; simp)
lemma [φreason %identity_element_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Elements⇩E (If C A B) D⇩A)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬C ⟹ Identity_Elements⇩E (If C A B) D⇩B)
⟹ Identity_Elements⇩E (If C A B) (If C D⇩A D⇩B)›
by (cases C; simp)
lemma [φreason %identity_element_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Element⇩I A Pa)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟹ Identity_Element⇩I B Pb)
⟹ Identity_Element⇩I (If C A B) (If C Pa Pb) ›
by (cases C; simp)
lemma [φreason %identity_element_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Element⇩E A)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟹ Identity_Element⇩E B)
⟹ Identity_Element⇩E (If C A B) ›
by (cases C; simp)
paragraph ‹Case Split of Sum Type›
subparagraph ‹Reduction›
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩E (A a)
⟹ Identity_Element⇩E (case_sum A B (Inl a)) ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩E (B b)
⟹ Identity_Element⇩E (case_sum A B (Inr b)) ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩I (A a) P
⟹ Identity_Element⇩I (case_sum A B (Inl a)) P ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Element⇩I (B b) P
⟹ Identity_Element⇩I (case_sum A B (Inr b)) P ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩E (A a) D
⟹ Identity_Elements⇩E (case_sum A B (Inl a)) D ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩E (B b) D
⟹ Identity_Elements⇩E (case_sum A B (Inr b)) D ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩I (A a) D P
⟹ Identity_Elements⇩I (case_sum A B (Inl a)) D P ›
by simp
lemma [φreason %identity_element_red]:
‹ Identity_Elements⇩I (B b) D P
⟹ Identity_Elements⇩I (case_sum A B (Inr b)) D P ›
by simp
subparagraph ‹Case Split›
lemma [φreason %identity_element_cut]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ Identity_Element⇩I (A a) (P a))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ Identity_Element⇩I (B b) (Q b))
⟹ Identity_Element⇩I (case_sum A B x) (pred_sum P Q x) ›
unfolding Premise_def
by (cases x; clarsimp)
lemma [φreason %identity_element_cut]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ Identity_Element⇩E (A a))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ Identity_Element⇩E (B b))
⟹ Identity_Element⇩E (case_sum A B x) ›
unfolding Premise_def
by (cases x; clarsimp)
lemma [φreason %identity_element_cut]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ Identity_Elements⇩I (A a) (D⇩A a) (P a))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ Identity_Elements⇩I (B b) (D⇩B b) (Q b))
⟹ Identity_Elements⇩I (case_sum A B x) (case_sum D⇩A D⇩B x) (case_sum P Q x) ›
unfolding Premise_def
by (cases x; clarsimp)
lemma [φreason %identity_element_cut]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ Identity_Elements⇩E (A a) (D⇩A a))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ Identity_Elements⇩E (B b) (D⇩B b))
⟹ Identity_Elements⇩E (case_sum A B x) (case_sum D⇩A D⇩B x) ›
unfolding Premise_def
by (cases x; clarsimp)
subsubsection ‹ToA Entry Point›
lemma [φreason default ! %identity_element_ToA]:
‹ Identity_Element⇩I X P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
unfolding Identity_Element⇩I_def Action_Tag_def .
lemma [φreason default ! %identity_element_ToA+1 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var ⦂ ○ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 ›]:
‹ Identity_Element⇩I X P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 () ⦂ ○ 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
unfolding Identity_Element⇩I_def Action_Tag_def
by simp
lemma [φreason default ! %identity_element_ToA]:
‹ Identity_Element⇩I X P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ ○ 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
unfolding Identity_Element⇩I_def Action_Tag_def
by simp
lemma [φreason default ! %identity_element_ToA]:
‹ Identity_Element⇩E X
⟹ 1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag 𝒯𝒫 ›
unfolding Identity_Element⇩E_def Action_Tag_def .
lemma [φreason default ! %identity_element_ToA+1 for ‹?var ⦂ ○ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 ›]:
‹ Identity_Element⇩E X
⟹ () ⦂ ○ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag 𝒯𝒫 ›
unfolding Identity_Element⇩E_def Action_Tag_def
by simp
lemma [φreason default ! %identity_element_ToA]:
‹ Identity_Element⇩E X
⟹ x ⦂ ○ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag 𝒯𝒫 ›
unfolding Identity_Element⇩E_def Action_Tag_def
by simp
subsubsection ‹Logic Connectives \& Basic φ-Types›
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩I Itself (λx. x = 1) (λ_. True) ›
unfolding Identity_Element⇩I_def Identity_Elements⇩I_def Transformation_def
by clarsimp
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩E Itself (λx. x = 1) ›
unfolding Identity_Element⇩E_def Identity_Elements⇩E_def Transformation_def
by clarsimp
lemma [φreason no explorative backtrack %identity_element_φ]:
‹ Identity_Elements⇩I T D P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ Identity_Element⇩I (x ⦂ T) (P x) ›
unfolding Identity_Element⇩I_def Identity_Elements⇩I_def Premise_def
using transformation_trans by fastforce
lemma [φreason no explorative backtrack %identity_element_φ+1 for ‹Identity_Element⇩I (?var ⦂ _) _›]:
‹ Identity_Elements⇩I T D P
⟹ Hint_Identity_Element T x ∨⇩c⇩u⇩t True
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ Identity_Element⇩I (x ⦂ T) (P x) ›
unfolding Identity_Element⇩I_def Identity_Elements⇩I_def Premise_def
Orelse_shortcut_def Ant_Seq_def
using transformation_trans by fastforce
lemma [φreason no explorative backtrack %identity_element_φ]:
‹ Identity_Elements⇩E T D
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ Identity_Element⇩E (x ⦂ T) ›
unfolding Identity_Element⇩E_def Identity_Elements⇩E_def Premise_def
using transformation_trans by fastforce
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩I A P1
⟹ Identity_Element⇩I B P2
⟹ Identity_Element⇩I (A + B) (P1 ∨ P2)›
unfolding Identity_Element⇩I_def Transformation_def
by simp
lemma
‹Identity_Element⇩I (A + B) P ⟹ Identity_Element⇩I A P ∧ Identity_Element⇩I B P›
unfolding Identity_Element⇩I_def Transformation_def
by clarsimp
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E A ∨ Identity_Element⇩E B
⟹ Identity_Element⇩E (A + B)›
unfolding Identity_Element⇩E_def Transformation_def
by clarsimp
lemma
‹ Identity_Element⇩E (A + B) ⟹ Identity_Element⇩E A ∧ Identity_Element⇩E B›
oops
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩I (A x) P
⟹ Identity_Element⇩I (AllSet A) P›
unfolding Identity_Element⇩I_def
by (metis AllSet_expn Transformation_def)
lemma [φreason %identity_element_cut]:
‹ (⋀x. Identity_Element⇩E (A x))
⟹ Identity_Element⇩E (AllSet A)›
unfolding Identity_Element⇩E_def
by (metis AllSet_expn Transformation_def)
lemma
‹ Identity_Element⇩E (AllSet A) ⟹ Identity_Element⇩E (A x) ›
unfolding Identity_Element⇩E_def Transformation_def
by clarsimp
lemma [φreason %identity_element_cut]:
‹(⋀x. Identity_Element⇩I (A x) (P x))
⟹ Identity_Element⇩I (ExSet A) (Ex P)›
unfolding Identity_Element⇩I_def
by (metis ExSet_expn Transformation_def)
lemma
‹Identity_Element⇩I (ExSet A) P ⟹ Identity_Element⇩I (A x) P›
unfolding Identity_Element⇩I_def Transformation_def
by (clarsimp; blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E (A x)
⟹ Identity_Element⇩E (ExSet A)›
unfolding Identity_Element⇩E_def Transformation_def
by (clarsimp; blast)
lemma
‹Identity_Element⇩E (ExSet A) ⟹ ∃x. Identity_Element⇩E (A x)›
unfolding Identity_Element⇩E_def Transformation_def ExSet_expn
by clarsimp
lemma [φreason %identity_element_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P ⟹ Identity_Element⇩I A Q)
⟹ Identity_Element⇩I (A 𝗌𝗎𝖻𝗃 P) (P ∧ Q)›
unfolding Identity_Element⇩I_def Transformation_def
by (simp; blast)
lemma
‹ Identity_Element⇩I (A 𝗌𝗎𝖻𝗃 P) (P ∧ Q) ⟹ (P ⟹ Identity_Element⇩I A Q)›
unfolding Identity_Element⇩I_def Transformation_def Satisfiable_def
by (cases P; clarsimp)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E A
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P
⟹ Identity_Element⇩E (A 𝗌𝗎𝖻𝗃 P)›
unfolding Identity_Element⇩E_def Transformation_def Premise_def
by (clarsimp; blast)
lemma
‹ Identity_Element⇩E (A 𝗌𝗎𝖻𝗃 P) ⟹ P ∧ Identity_Element⇩E A ›
unfolding Identity_Element⇩E_def Transformation_def Premise_def
by (clarsimp; blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩I A P
⟹ Identity_Element⇩I B Q
⟹ Identity_Element⇩I (A * B) (P ∧ Q) ›
for A :: ‹'a::sep_magma_1 BI›
unfolding Identity_Element⇩I_def Transformation_def
by (clarsimp simp add: set_mult_expn, insert mult_1_class.mult_1_left; blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E A
⟹ Identity_Element⇩E B
⟹ Identity_Element⇩E (A * B) ›
for A :: ‹'a::sep_magma_1 BI›
unfolding Identity_Element⇩E_def Transformation_def
by (clarsimp, insert mult_1_class.mult_1_left sep_magma_1_left, blast)
lemma
‹ Identity_Element⇩E (A * B) ⟹ Identity_Element⇩E A ∧ Identity_Element⇩E B ›
for A :: ‹'a::sep_magma_1 BI›
oops
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩I T D⇩T P
⟹ Identity_Elements⇩I U D⇩U Q
⟹ Identity_Elements⇩I (T ∗ U) (λ(x,y). D⇩T x ∧ D⇩U y) (λ(x,y). P x ∧ Q y)›
for T :: ‹('a::sep_magma_1, 'b) φ›
unfolding Identity_Element⇩I_def Identity_Elements⇩I_def φProd_expn' Transformation_def
by (simp add: set_mult_expn, insert mult_1_class.mult_1_left, blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩E T D⇩T
⟹ Identity_Elements⇩E U D⇩U
⟹ Identity_Elements⇩E (T ∗ U) (λ(x,y). D⇩T x ∧ D⇩U y) ›
for T :: ‹'a ⇒ 'b::sep_magma_1 BI›
unfolding Identity_Element⇩E_def Identity_Elements⇩E_def Transformation_def
by (clarsimp simp add: φProd_expn', insert set_mult_expn, fastforce)
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩I T D⇩T P
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Elements⇩I U D⇩U Q)
⟹ Identity_Elements⇩I (T ∗[C] U) (λ(x,y). D⇩T x ∧ (C ⟶ D⇩U y)) (λ(x,y). P x ∧ (C ⟶ Q y)) ›
for T :: ‹('c::sep_magma_1, 'x) φ›
unfolding Identity_Element⇩I_def Identity_Elements⇩I_def Transformation_def Premise_def
by (cases C; clarsimp simp add: φProd_expn'; insert mult_1_class.mult_1_right; blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E A
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Element⇩E B)
⟹ Identity_Element⇩E (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B) ›
for A :: ‹'a::sep_magma_1 BI›
unfolding Identity_Element⇩E_def Transformation_def REMAINS_def
by (clarsimp, insert mult_1_class.mult_1_left sep_magma_1_left, blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩I A P
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Element⇩I B Q)
⟹ Identity_Element⇩I (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B) (P ∧ (C ⟶ Q)) ›
for A :: ‹'a::sep_magma_1 BI›
unfolding Identity_Element⇩I_def Transformation_def Premise_def REMAINS_def
by (clarsimp, insert mult_1_class.mult_1_right, blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩E T D⇩T
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Identity_Elements⇩E U D⇩U)
⟹ Identity_Elements⇩E (T ∗[C] U) (λ(x,y). D⇩T x ∧ (C ⟶ D⇩U y)) ›
for T :: ‹('c::sep_magma_1, 'x) φ›
unfolding Identity_Element⇩E_def Identity_Elements⇩E_def Transformation_def Premise_def
by (cases C; clarsimp simp add: φProd_expn'; insert mult_1_class.mult_1_right sep_magma_1_left; blast)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩E A
⟹ Identity_Element⇩E B
⟹ Identity_Element⇩E (A ∧⇩B⇩I B) ›
unfolding Identity_Element⇩E_def Transformation_def
by (clarsimp)
lemma
‹ Identity_Element⇩E (A ∧⇩B⇩I B) ⟹ Identity_Element⇩E A ∧ Identity_Element⇩E B ›
unfolding Identity_Element⇩E_def Transformation_def
by (clarsimp)
lemma [φreason %identity_element_cut]:
‹ Identity_Element⇩I A P ∨ Identity_Element⇩I B Q
⟹ Identity_Element⇩I (A ∧⇩B⇩I B) (P ∨ Q)›
unfolding Identity_Element⇩I_def Transformation_def
by (clarsimp, blast)
lemma
‹ Identity_Element⇩I (A ∧⇩B⇩I B) True ⟹ Identity_Element⇩I A True ∨ Identity_Element⇩I B True ›
oops
lemma [φreason %identity_element_cut]:
‹ (⋀i∈I. Identity_Element⇩I (A i) (P i))
⟹ Identity_Element⇩I (✱i∈I. A i) (∀i∈I. P i)›
unfolding Identity_Element⇩I_def Mul_Quant_def Transformation_def meta_Ball_def Premise_def
proof clarsimp
fix v
assume prems: ‹(⋀i. i ∈ I ⟹ ∀v. v ⊨ A i ⟶ v = 1 ∧ P i)›
‹v ⊨ prod A I›
and ‹finite I›
show ‹v = 1 ∧ (∀x∈I. P x)›
by (insert prems; induct rule: finite_induct[OF ‹finite I›]; clarsimp; fastforce)
qed
lemma [φreason %identity_element_cut]:
‹ (⋀i∈S. Identity_Element⇩E (A i))
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 finite S
⟹ Identity_Element⇩E (✱i∈S. A i) ›
unfolding Identity_Element⇩E_def Mul_Quant_def Transformation_def Premise_def meta_Ball_def
proof clarsimp
fix v
assume prems: ‹(⋀i. i ∈ S ⟹ 1 ⊨ A i)›
and ‹finite S›
show ‹1 ⊨ prod A S›
by (insert prems;
induct rule: finite_induct[OF ‹finite S›];
clarsimp;
(insert mult_1_class.mult_1_left sep_magma_1_right, blast))
qed
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩I (◒[C] T) (λ_. ¬ C) (λ_. True) ›
unfolding Identity_Element⇩I_def Identity_Elements⇩I_def Transformation_def Premise_def
by simp
lemma [φreason %identity_element_cut]:
‹ Identity_Elements⇩E (◒[C] T) (λ_. ¬ C) ›
unfolding Identity_Element⇩E_def Identity_Elements⇩E_def Transformation_def Premise_def
by clarsimp
lemma prevent_eliminate_IEE_φCond_Unital[no_atp]:
‹ False
⟹ Identity_Elements⇩E (◒[C] T) Any ›
by blast
lemma prevent_eliminate_IEI_φCond_Unital[no_atp]:
‹ False
⟹ Identity_Elements⇩I (◒[C] T) Any Any' ›
by blast
bundle prevent_eliminate_IE_φCond_Unital =
prevent_eliminate_IEE_φCond_Unital[φreason %identity_element_top]
prevent_eliminate_IEI_φCond_Unital[φreason %identity_element_top]
subsection ‹Equivalence of Objects›
definition Object_Equiv :: ‹('c,'a) φ ⇒ ('a ⇒ 'a ⇒ bool) ⇒ bool›
where ‹Object_Equiv T eq ⟷ (∀x. eq x x) ∧ (∀x y. eq x y ⟶ (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T))›
text ‹φ-Deriver usually derives the object reachability relation of φ-type operators generally
for any variable type operand, but the reachability can be wider on specific type operands, such
as the reachability ‹λx y. True› of ‹List(○)› versus the version ‹λx y. length x = length y› instantiated
from the general rule ‹Object_Equiv T eq ⟹ Object_Equiv (List T) (list_rel eq)› by substituting
‹T› for ‹○› and ‹eq› for ‹(=)›.
These special `singular` cases are hard to be handled by φ-type algebra who provides a general automation,
thus demanding user rules for override. Even so, common singular cases can still be handled by ad-hoc
optimization in the algorithm.
Generally, when an instantiation of a type operand yields a trivial type relating empty concrete objects,
a singular case can occur. Therefore, when we infer the reachability of a given type, we can first
check if it is such a trivial type and if so we derive the wider relation by rule (see ‹𝒜_singular_unit›).
In this way, the overall reasoning can still be powerful even when such common singular cases are not considered.
(paper)
›
declare [[
φreason_default_pattern ‹Object_Equiv ?T _› ⇒ ‹Object_Equiv ?T _› (100),
φpremise_attribute once? [φreason? %local] for ‹Object_Equiv _ _› (%φattr)
]]
φreasoner_group object_equiv = (100, [1, 3999]) for ‹Object_Equiv T eq›
‹Reasoning rules giving the equivalence relation (though is actually a reachability
relation) of objects of the given φ-type.›
and object_equiv_cut = (%cutting, [%cutting, %cutting+10]) for ‹Object_Equiv T eq› in object_equiv
‹Cutting rules for reasonig Object_Equiv›
and derived_object_equiv = (50, [50,50]) for ‹Object_Equiv T eq› in object_equiv and < object_equiv_cut
‹Automatically derived rules for Object_Equiv›
and object_equiv_fallback = (1, [1,1]) for ‹Object_Equiv T eq› in object_equiv and < derived_object_equiv
‹Fallback rules for reasonig Object_Equiv›
subsubsection ‹Variants›
consts 𝒜_singular_unit :: action
declare [[
φreason_default_pattern ‹Object_Equiv ?T _ @tag 𝒜_singular_unit› ⇒
‹Object_Equiv ?T _ @tag 𝒜_singular_unit› (100)
]]
lemma [φreason %object_equiv_cut+1]:
‹ Identity_Elements⇩I T D⇩I P
⟹ Identity_Elements⇩E T D⇩E
⟹ Object_Equiv T eq
⟹ Object_Equiv T (λx y. eq x y ∨ D⇩I x ∧ (P x ⟶ D⇩E y)) @tag 𝒜_singular_unit ›
unfolding Object_Equiv_def Identity_Elements⇩E_def Identity_Elements⇩I_def Action_Tag_def
Transformation_def Identity_Element⇩I_def Identity_Element⇩E_def
by clarsimp blast
lemma [φreason %object_equiv_cut]:
‹ Object_Equiv T eq
⟹ Object_Equiv T eq @tag 𝒜_singular_unit ›
unfolding Action_Tag_def
by clarsimp
subsubsection ‹Its Role in ToA›
subsubsection ‹Extracting Pure Facts›
lemma [φreason %extract_pure]:
‹ (⋀x y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 eq x y ⟹ 𝗋EIF (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T) (P x y) )
⟹ 𝗋EIF (Object_Equiv T eq) ((∀x. eq x x) ∧ (∀x y. eq x y ⟶ P x y))›
unfolding 𝗋EIF_def Object_Equiv_def Premise_def Transformation_def
by clarsimp
lemma [φreason %extract_pure]:
‹ (⋀x y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 eq x y ⟹ 𝗋ESC (P x y) (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T))
⟹ 𝗋ESC ((∀x. eq x x) ∧ (∀x y. eq x y ⟶ P x y)) (Object_Equiv T eq) ›
unfolding 𝗋ESC_def Object_Equiv_def Premise_def Transformation_def
by clarsimp
subsubsection ‹Reasoning Rules›
lemma Object_Equiv_fallback[φreason default %object_equiv_fallback]:
‹Object_Equiv T (=)›
unfolding Object_Equiv_def by simp
lemma [φreason %object_equiv_cut]:
‹ Object_Equiv ○ (λ_ _. True) ›
unfolding Object_Equiv_def Transformation_def
by simp
lemma [φreason %object_equiv_cut]:
‹ (⋀a. Object_Equiv (λx. S x a) (R a))
⟹ Object_Equiv (λx. ExSet (S x)) (λx y. ∀a. R a x y) ›
unfolding Object_Equiv_def Transformation_def φType_def
by (clarsimp; blast)
lemma [φreason %object_equiv_cut]:
‹ Object_Equiv S R
⟹ Object_Equiv (λx. S x 𝗌𝗎𝖻𝗃 P x) (λx y. P x ⟶ R x y ∧ P y) ›
unfolding Object_Equiv_def Transformation_def φType_def
by clarsimp
lemma [φreason %object_equiv_cut]:
‹ Object_Equiv S1 R1
⟹ Object_Equiv S2 R2
⟹ Object_Equiv (λx. S1 x ∧⇩B⇩I S2 x) (λx y. R1 x y ∧ R2 x y) ›
unfolding Object_Equiv_def Transformation_def φType_def
by clarsimp
lemma [φreason %object_equiv_cut]:
‹ Object_Equiv S1 R1
⟹ Object_Equiv S2 R2
⟹ Object_Equiv (λx. S1 x + S2 x) (λx y. R1 x y ∧ R2 x y) ›
unfolding Object_Equiv_def Transformation_def φType_def
by clarsimp
lemma [φreason %object_equiv_cut]:
‹ (⋀a. Object_Equiv (λx. S x a) (R a))
⟹ Object_Equiv (λx. AllSet (S x)) (λx y. ∀a. R a x y) ›
unfolding Object_Equiv_def Transformation_def φType_def
by (clarsimp simp add: AllSet_expn; blast)
lemma [φreason %object_equiv_cut]:
‹ Object_Equiv S1 R1
⟹ Object_Equiv S2 R2
⟹ Object_Equiv (λx. S1 x * S2 x) (λ x y. R1 x y ∧ R2 x y) ›
unfolding Object_Equiv_def Transformation_def φType_def
by (clarsimp simp add: set_mult_expn; blast)
lemma
‹ Object_Equiv S1 R1
⟹ Object_Equiv S2 R2
⟹ Object_Equiv (λx. {p. p ⊨ S1 x ⟶ p ⊨ S2 x}) (λx y. R1 y x ∧ R2 x y) ›
unfolding Object_Equiv_def Transformation_def φType_def
by (clarsimp simp add: Satisfaction_def)
lemma [φreason %object_equiv_cut]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ Object_Equiv A Ea)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟹ Object_Equiv B Eb)
⟹ Object_Equiv (if C then A else B) (if C then Ea else Eb) ›
unfolding Premise_def
by (cases C; simp)
lemma Object_Equiv_Mul_Quant[φreason %object_equiv_cut]:
‹ (∀i x. eq i x x)
⟹ (⋀i∈S. Object_Equiv (λx. A x i) (eq i))
⟹ Object_Equiv (λx. ✱i∈S. A x i) (λx y. ∀i. eq i x y)›
unfolding Object_Equiv_def Transformation_def φType_def
meta_Ball_def Premise_def Mul_Quant_def
proof (clarsimp, unfold Satisfaction_def)
fix x y v
assume prems: ‹(⋀x. x ∈ S ⟹ ∀xa y. eq x xa y ⟶ (∀v. v ∈ A xa x ⟶ v ∈ A y x))›
‹∀i. eq i x y›
‹v ∈ prod (A x) S›
and ‹finite S›
show ‹v ∈ prod (A y) S›
by (insert prems;
induct arbitrary: x y v rule: finite_induct[OF ‹finite S›];
clarsimp simp add: set_mult_expn;
metis)
qed
section ‹Reasoning›
ML_file ‹library/syntax/Phi_Syntax0.ML›
subsection ‹Preliminary›
subsubsection ‹Mapping φ-Type Items by Transformation›
consts 𝒜_map_each_item :: ‹action ⇒ action›
declare [[φreason_default_pattern
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜_map_each_item _› ⇒
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜_map_each_item _› (100)
and ‹?X @tag 𝒜_map_each_item ?𝒜 › ⇒
‹ERROR TEXT(‹Bad Rule: › (?X @tag 𝒜_map_each_item ?𝒜)) › (0)
]]
φreasoner_group 𝒜_map_each_item = (1050, [1010, 3000]) for (‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜_map_each_item 𝒜›)
‹Reasoning rules applying action ‹𝒜› onto each atomic items in ‹X››
and 𝒜_map_each_item_fallback = (1000, [1000, 1000]) for (‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜_map_each_item 𝒜›)
‹Fallback rules ending 𝒜_map_each_item›
paragraph ‹Implementation›
lemma [φreason %𝒜_map_each_item]:
‹ 1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 @tag 𝒜_map_each_item A ›
unfolding Action_Tag_def
by simp
lemma [φreason %𝒜_map_each_item]:
‹ 0 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 0 @tag 𝒜_map_each_item A ›
unfolding Action_Tag_def
by simp
lemma [φreason %𝒜_map_each_item]:
‹ ⊤ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ⊤ @tag 𝒜_map_each_item A ›
unfolding Action_Tag_def
by simp
lemma [φreason %𝒜_map_each_item]:
‹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A)
⟹ X 𝗌𝗎𝖻𝗃 Q 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗌𝗎𝖻𝗃 Q 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A›
unfolding Action_Tag_def Premise_def Transformation_def
by simp blast
lemma [φreason %𝒜_map_each_item]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item 𝒜
⟹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q @tag 𝒜_map_each_item 𝒜
⟹ A ∧⇩B⇩I B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X ∧⇩B⇩I Y 𝗐𝗂𝗍𝗁 P ∧ Q @tag 𝒜_map_each_item 𝒜›
unfolding Action_Tag_def Transformation_def
by simp blast
lemma [φreason %𝒜_map_each_item]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item 𝒜
⟹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q @tag 𝒜_map_each_item 𝒜
⟹ A + B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X + Y 𝗐𝗂𝗍𝗁 P ∨ Q @tag 𝒜_map_each_item 𝒜›
unfolding Action_Tag_def Transformation_def
by simp
lemma [φreason %𝒜_map_each_item]:
‹ (⋀c. X c 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y c 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A)
⟹ ExSet X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ExSet Y 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A›
unfolding Action_Tag_def
using ExSet_transformation .
lemma [φreason %𝒜_map_each_item]:
‹ (⋀c. X c 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y c 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A)
⟹ AllSet X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 AllSet Y 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A›
unfolding Action_Tag_def Transformation_def
by simp blast
lemma [φreason %𝒜_map_each_item]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item 𝒜
⟹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q @tag 𝒜_map_each_item 𝒜
⟹ A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X * Y 𝗐𝗂𝗍𝗁 P ∧ Q @tag 𝒜_map_each_item 𝒜 ›
unfolding Action_Tag_def Transformation_def
by simp blast
lemma [φreason %𝒜_map_each_item]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A
⟹ W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R 𝗐𝗂𝗍𝗁 Q @tag 𝒜_map_each_item A
⟹ X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ∧ (C ⟶ Q) @tag 𝒜_map_each_item A›
unfolding REMAINS_def
by (cases C; simp add: Action_Tag_def transformation_bi_frame;
metis transformation_bi_frame transformation_weaken)
lemma [φreason %𝒜_map_each_item]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A' 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item 𝒜)
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B' 𝗐𝗂𝗍𝗁 Q @tag 𝒜_map_each_item 𝒜)
⟹ If C A B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If C A' B' 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒜_map_each_item 𝒜›
unfolding Action_Tag_def Premise_def
by (cases C; simp)
lemma [φreason %𝒜_map_each_item]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ A a 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A' a 𝗐𝗂𝗍𝗁 P a @tag 𝒜_map_each_item 𝒜)
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ B b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B' b 𝗐𝗂𝗍𝗁 Q b @tag 𝒜_map_each_item 𝒜)
⟹ (case_sum A B x) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (case_sum A' B' x) 𝗐𝗂𝗍𝗁 case_sum P Q x @tag 𝒜_map_each_item 𝒜›
unfolding Action_Tag_def Premise_def
by (cases x; simp)
lemma [φreason %𝒜_map_each_item]:
‹ (⋀i∈I. A i 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B i 𝗐𝗂𝗍𝗁 P i @tag 𝒜_map_each_item 𝒜)
⟹ (✱i∈I. A i) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (✱i∈I. B i) 𝗐𝗂𝗍𝗁 (∀i ∈ I. P i) @tag 𝒜_map_each_item 𝒜 ›
unfolding Action_Tag_def Premise_def
by (clarsimp simp add: sep_quant_transformation)
lemma [φreason %𝒜_map_each_item_fallback]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag A
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜_map_each_item A›
unfolding Action_Tag_def .
subsection ‹Normalization of Assertions›
subsubsection ‹Declaring Simpsets›
consts assertion_simps :: ‹mode ⇒ mode›
SOURCE :: mode
TARGET :: mode
ML ‹
structure Assertion_SS = Simpset (
val initial_ss = Simpset_Configure.Minimal_SS
val binding = SOME \<^binding>‹assertion_simps›
val comment = "Simplification rules normalizing an assertion. \
\It is applied before NToA process."
val attribute = NONE
val post_merging = I
)
val _ = Theory.setup (Context.theory_map (Assertion_SS.map (fn ctxt =>
(ctxt addsimprocs [\<^simproc>‹NO_MATCH›, \<^simproc>‹defined_Ex›, \<^simproc>‹HOL.defined_All›,
\<^simproc>‹defined_all›, \<^simproc>‹defined_Collect›, \<^simproc>‹Set.defined_All›,
\<^simproc>‹Set.defined_Bex›, \<^simproc>‹unit_eq›, \<^simproc>‹case_prod_beta›,
\<^simproc>‹case_prod_eta›, \<^simproc>‹Collect_mem›,
Phi_Conv.move_Ex_for_set_notation]
addsimps @{thms' Sum_Type.sum.case HOL.simp_thms})
)))
structure Assertion_SS_Source = Simpset (
val initial_ss = Simpset_Configure.Empty_SS
val binding = SOME \<^binding>‹assertion_simps_source›
val comment = "Simp rules normalizing particularly source part of an assertion."
val attribute = NONE
val post_merging = I
)
val _ = Theory.setup (Context.theory_map (Assertion_SS_Source.map (fn ctxt =>
ctxt addsimps @{thms' ExSet_defined}
|> Simplifier.add_cong @{thm' Subjection_cong}
)))
structure Assertion_SS_Target = Simpset (
val initial_ss = Simpset_Configure.Empty_SS
val binding = SOME \<^binding>‹assertion_simps_target›
val comment = "Simp rules normalizing particularly target part of an assertion."
val attribute = NONE
val post_merging = I
)
›
lemmas [assertion_simps] =
mult_zero_right[where 'a=‹'a::sep_magma BI›] mult_zero_left[where 'a=‹'a::sep_magma BI›]
mult_1_right[where 'a=‹'a::sep_magma_1 BI›]
mult_1_left[where 'a=‹'a::sep_magma_1 BI›]
add_0_right[where 'a=‹'a::sep_magma BI›] add_0_left[where 'a=‹'a::sep_magma BI›]
zero_fun zero_fun_def[symmetric, where 'b=‹'a::sep_magma BI›]
plus_fun[where 'a=‹'a::sep_magma BI›]
distrib_right[where 'a=‹'a::sep_semigroup BI›]
mult.assoc[where 'a=‹'a::sep_semigroup BI›]
bot_eq_BI_bot
Subjection_Subjection Subjection_Zero Subjection_True Subjection_Flase
Subjection_times Subjection_addconj
ExSet_simps ExSet_split_prod ExSet_subj_split_prod
sep_quant_subjection sep_quant_ExSet
φProd_expn'' φProd_expn'
REMAINS_simp(2)
HOL.if_True HOL.if_False
φBot.unfold φAny.unfold
fst_conv snd_conv
lemmas [assertion_simps_source] =
ExSet_times_left ExSet_times_right ExSet_adconj ExSet_addisj
REMAINS_simp(1)
sep_quant_sep
lemmas [assertion_simps_target] =
sep_quant_sep[symmetric]
lemmas [φprogramming_base_simps, φprogramming_simps, φsafe_simp] =
add_0_right[where 'a=‹'a::sep_magma set›] add_0_left[where 'a=‹'a::sep_magma set›]
zero_fun_def[symmetric, where 'b=‹'a::sep_magma BI›]
plus_fun[where 'a=‹'a::sep_magma BI›]
distrib_right[where 'a=‹'a::sep_semigroup BI›]
mult.assoc[where 'a=‹'a::sep_semigroup BI›]
lemmas [φprogramming_base_simps] =
mult_zero_right[where 'a=‹'a::sep_magma set›] mult_zero_left[where 'a=‹'a::sep_magma set›]
mult_1_right[where 'a=‹'a::sep_magma_1 set›] mult_1_left[where 'a=‹'a::sep_magma_1 set›]
zero_fun
HOL.simp_thms
REMAINS_simp(2)
HOL.if_True HOL.if_False
ML_file ‹library/reasoning/quantifier.ML›
simproc_setup defined_ExSet ( ‹ExSet A› ) = ‹K BI_Quantifiers.defined_Ex›
setup ‹Context.theory_map (Phi_Programming_Simp_Hook.add 100 (fn () => fn ctxt =>
ctxt delsimprocs [@{simproc defined_ExSet}]
delsimps @{thms' ExSet_defined}))
›
setup ‹Context.theory_map (
Assertion_SS_Source.map (fn ctxt =>
ctxt addsimprocs [@{simproc defined_ExSet}] ) #>
Assertion_SS.map (fn ctxt =>
ctxt addsimprocs [@{simproc Funcomp_Lambda}]) #>
Phi_Safe_Simps.map (fn ctxt =>
ctxt addsimprocs [@{simproc defined_ExSet}, @{simproc Funcomp_Lambda}]))›
subsubsection ‹Reasoners›
φreasoner_ML assertion_simp_source 1300
(‹Simplify (assertion_simps SOURCE) ?X' ?X›)
= ‹Phi_Reasoners.wrap (PLPR_Simplifier.simplifier_by_ss' (K Seq.empty) (fn ctxt =>
Raw_Simplifier.merge_ss (Assertion_SS.get' ctxt, Assertion_SS_Source.get' ctxt)) {fix_vars=false}) o snd›
φreasoner_ML assertion_simp_target 1300
(‹Simplify (assertion_simps TARGET) ?X' ?X›)
= ‹Phi_Reasoners.wrap (PLPR_Simplifier.simplifier_by_ss' (K Seq.empty) (fn ctxt =>
Raw_Simplifier.merge_ss (Assertion_SS.get' ctxt, Assertion_SS_Target.get' ctxt)) {fix_vars=false}) o snd›
φreasoner_ML assertion_simp 1200
(‹Premise (assertion_simps _) _› | ‹Simplify (assertion_simps ?ANY) ?X' ?X› )
= ‹Phi_Reasoners.wrap (PLPR_Simplifier.simplifier_by_ss' (K Seq.empty) Assertion_SS.get' {fix_vars=false}) o snd›
ML ‹
fun conv_transformation_by_assertion_ss ctxt =
let val src_ctxt = Assertion_SS_Source.enhance (Assertion_SS.equip ctxt)
val target_ctxt = Assertion_SS_Target.enhance (Assertion_SS.equip ctxt)
in Phi_Syntax.transformation_conv (Simplifier.rewrite src_ctxt)
(Simplifier.rewrite target_ctxt)
Conv.all_conv
end
fun skolemize_transformation ctxt th =
let fun skolem th =
(case Phi_Syntax.dest_transformation (Thm.major_prem_of th)
of (Const(\<^const_name>‹ExSet›, _) $ _,
Const(\<^const_name>‹φTagA›, _) $ _ $ (Const(\<^const_name>‹REMAINS›, _) $ _ $ _ $ _), _) =>
skolem (@{thm' skolemize_transformation_tR} RS th)
| (Const(\<^const_name>‹ExSet›, _) $ _,
Const(\<^const_name>‹REMAINS›, _) $ _ $ _ $ _, _) =>
skolem (@{thm' skolemize_transformation_R} RS th)
| (Const(\<^const_name>‹ExSet›, _) $ _, _, _) =>
skolem (@{thm' skolemize_transformation} RS th)
| _ => th)
in th
|> Conv.gconv_rule (Phi_Conv.hhf_concl_conv (fn ctxt =>
conv_transformation_by_assertion_ss ctxt
) ctxt) 1
|> skolem
end
›
subsection ‹Transformation-based Simplification›
type_synonym forward_direction = bool
type_synonym substantial_change = bool
consts 𝒜simp' :: ‹ forward_direction ⇒ substantial_change ⇒ action ›
𝒜_transitive_simp' :: ‹ forward_direction ⇒ substantial_change ⇒ action›
abbreviation ‹𝒜simp ≡ 𝒜simp' True True›
abbreviation ‹𝒜_transitive_simp ≡ 𝒜_transitive_simp' True True›
abbreviation ‹𝒜backward_simp ≡ 𝒜simp' False True›
abbreviation ‹𝒜_backward_transitive_simp ≡ 𝒜_transitive_simp' False True›
text ‹Potentially weakening transformations designed for simplifying state sequents of the CoP.
\<^prop>‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r y @tag 𝒜simp›
Doing this simplification in the framework of To-Transformation benefits it by reusing the
To-Transformation support in transformation functors, which brings the simplification into the elements.
The simplification is very heavy.
For the sake of performance, it is indolent and is applied only when the state sequent
needs the simplification. There is a mechanism to detect such need. The default strategy is,
we collect all the registered simplification rules, get the pattern of the source type of the
transformations, and if the types of a state sequent match any of a pattern, the simplification
is required and activated.
This default strategy is not perfect, so we provide hooks by which users can provide ML checkers.
The checker can bind on either the whole types or subterms of specific constant heads.
The checker only checks the type part.
Note \<^prop>‹A @tag 𝒜simp› requires the process at least make one meaningful simplification
step at least simplifies something, while \<^prop>‹A @tag 𝒜simp' direction False› allows returning with no-change.
User can indicate to the system that his reasoning rule \<^prop>‹A @tag 𝒜simp' direction substantial_change› is
meaningful by set ‹substantial_change ≡ True›, or ‹False› otherwise.
›
subsubsection ‹Convention›
φreasoner_group φsimp_all = (100, [1,4000]) for ( ‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜simp' direction substantial_change› )
‹Simplifying the assertion by means of transformation, which may weaken the assertion and
refine the abstraction (or backwardly strengthen by ‹𝒜backward_simp›)›
and φsimp_system_fallback = (1, [1,2]) in φsimp_all
‹System fallbacks of transformation-based simplification rule, which simplify nothing›
and φsimp = (1000, [3, 4000]) in φsimp_all and > φsimp_system_fallback
‹User rules of transformation-based simplification›
and φsimp_fallback = (10, [5,20]) in φsimp
‹Fallbacks of transformation-based simplification›
and φsimp_derived = (50, [30,70]) in φsimp and > φsimp_fallback and < default
‹Automatically derived transformation-based simplification›
and φsimp_cut = (1000, [1000, 1030]) in φsimp
‹Cutting rules of transformation-based simplification›
declare [[ φreason_default_pattern
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ _ 𝗌𝗎𝖻𝗃 y. _) 𝗐𝗂𝗍𝗁 ?P @tag 𝒜simp' True ?flag› ⇒
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜simp' True ?flag› (100)
and ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ _ 𝗌𝗎𝖻𝗃 y. _) 𝗐𝗂𝗍𝗁 ?P @tag 𝒜_transitive_simp' True ?flag› ⇒
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜_transitive_simp' True ?flag› (100)
and ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ ?T y 𝗌𝗎𝖻𝗃 y. _) 𝗐𝗂𝗍𝗁 ?P @tag 𝒜simp' False ?flag› ⇒
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ ?T y 𝗌𝗎𝖻𝗃 y. _) 𝗐𝗂𝗍𝗁 _ @tag 𝒜simp' False ?flag› (100)
and ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ ?T y 𝗌𝗎𝖻𝗃 y. _) 𝗐𝗂𝗍𝗁 ?P @tag 𝒜_transitive_simp' False ?flag› ⇒
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ ?T y 𝗌𝗎𝖻𝗃 y. _) 𝗐𝗂𝗍𝗁 _ @tag 𝒜_transitive_simp' False ?flag› (100)
and ‹?X @tag 𝒜simp' ?direction ?flag› ⇒
‹ERROR TEXT(‹Bad form: › (?X @tag 𝒜simp' ?direction ?flag) ⏎
‹Expect: ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ ?Y 𝗌𝗎𝖻𝗃 y. ?r y) @tag 𝒜simp››)› (0)
and ‹?X @tag 𝒜_transitive_simp' ?direction ?flag› ⇒
‹ERROR TEXT(‹Bad form: › (?X @tag 𝒜_transitive_simp' ?direction ?flag) ⏎
‹Expect: ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y ⦂ ?Y 𝗌𝗎𝖻𝗃 y. ?r y) @tag 𝒜simp››)› (0)
]]
subsubsection ‹Implementation›
consts 𝒜simp_if_need :: ‹forward_direction ⇒ substantial_change ⇒ action›
𝒜transitive_simp_if_need :: ‹forward_direction ⇒ substantial_change ⇒ action›
𝒜_apply_simplication :: ‹action›
lemma [φreason %cutting for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜_apply_simplication›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y' 𝗐𝗂𝗍𝗁 Any @tag 𝒜_map_each_item (𝒜transitive_simp_if_need True False)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[assertion_simps SOURCE] Y : Y'
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒜_apply_simplication ›
unfolding Action_Tag_def Transformation_def Simplify_def
by simp
lemma 𝒜simp_invoke:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Any @tag 𝒜_map_each_item (𝒜transitive_simp_if_need True False)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y ›
unfolding Action_Tag_def
by (simp add: transformation_weaken)
lemma 𝒜simp_trans:
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r y @tag 𝒜_transitive_simp' direction Any
⟹ (⋀y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 r y ⟹ y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. w y z @tag 𝒜simp_if_need direction M)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r' : (λz. ∃y. r y ∧ w y z)
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. r' z @tag 𝒜simp' direction Any2 ›
unfolding Action_Tag_def Transformation_def Simplify_def
by simp blast
lemma 𝒜simp_trans_backward:
‹ (⋀x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 w x ⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_transitive_simp' direction Any)
⟹ z ⦂ Z 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗌𝗎𝖻𝗃 x. w x @tag 𝒜simp_if_need direction M
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r' : (λy. ∃x. r x y ∧ w x)
⟹ z ⦂ Z 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜simp' direction Any2 ›
unfolding Action_Tag_def Transformation_def Simplify_def
by simp blast
lemma 𝒜simp_trans':
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. y = y' @tag 𝒜_transitive_simp' direction Any
⟹ y' ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. w z @tag 𝒜simp_if_need direction M
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. w z @tag 𝒜simp' direction Any2 ›
unfolding Action_Tag_def Transformation_def
by simp
lemma 𝒜simp_trans'P:
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. y = y' ∧ P y @tag 𝒜_transitive_simp' direction Any
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P y' ⟹ y' ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. w z @tag 𝒜simp_if_need direction M)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r' : (λz. w z ∧ P y')
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. r' z @tag 𝒜simp' direction Any2 ›
unfolding Action_Tag_def Transformation_def Simplify_def
by simp
ML_file ‹library/tools/CoP_simp.ML›
context begin
private lemma 𝒜simp_chk_no_need:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag 𝒜simp_if_need direction Any›
unfolding Action_Tag_def
by simp
private lemma 𝒜simp_chk_no_need':
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T 𝗌𝗎𝖻𝗃 y. y = x @tag 𝒜simp_if_need direction Any›
unfolding Action_Tag_def
by (simp add: ExSet_defined)
private lemma 𝒜simp_chk_go:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒜simp' direction M
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒜simp_if_need direction M›
unfolding Action_Tag_def .
private lemma 𝒜simp_chk_go_transitive:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r y @tag 𝒜simp' direction M
⟹ ∀y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 r y ⟶ (y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. w y z @tag 𝒜transitive_simp_if_need direction False)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r' : (λz. ∃y. r y ∧ w y z)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. r' z @tag 𝒜transitive_simp_if_need direction M›
unfolding Action_Tag_def Transformation_def Premise_def Simplify_def
by clarsimp blast
private lemma 𝒜simp_chk_go_transitive':
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r y @tag 𝒜simp' direction M
⟹ ∀y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 r y ⟶ (y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. w y z @tag 𝒜transitive_simp_if_need direction False)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r' : (λz. ∃y. r y ∧ w y z)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[assertion_simps SOURCE] Z' : z ⦂ Z 𝗌𝗎𝖻𝗃 z. r' z
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Z' @tag 𝒜transitive_simp_if_need direction M›
unfolding Action_Tag_def Transformation_def Premise_def Simplify_def
by clarsimp blast
private lemma 𝒜simp_chk_go_transitive_backward:
‹ (⋀y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 w y ⟹ y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. r y z @tag 𝒜simp' direction M)
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. w y @tag 𝒜transitive_simp_if_need direction False
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r' : (λz. ∃y. w y ∧ r y z)
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. r' z @tag 𝒜transitive_simp_if_need direction M›
unfolding Action_Tag_def Transformation_def Premise_def Simplify_def
by clarsimp blast
private lemma 𝒜simp_chk_go_transitive_backward':
‹ (⋀y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 w y ⟹ y ⦂ U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z ⦂ Z 𝗌𝗎𝖻𝗃 z. r y z @tag 𝒜simp' direction M)
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. w y @tag 𝒜transitive_simp_if_need direction False
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r' : (λz. ∃y. w y ∧ r y z)
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[assertion_simps SOURCE] Z' : z ⦂ Z 𝗌𝗎𝖻𝗃 z. r' z
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Z' @tag 𝒜transitive_simp_if_need direction M›
unfolding Action_Tag_def Transformation_def Premise_def Simplify_def
by clarsimp blast
private lemma 𝒜simp_chk_no_need_transitive:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag 𝒜transitive_simp_if_need direction Any›
unfolding Action_Tag_def
by simp
private lemma 𝒜simp_chk_no_need'_transitive:
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T 𝗌𝗎𝖻𝗃 y. y = x @tag 𝒜transitive_simp_if_need direction Any›
unfolding Action_Tag_def
by (simp add: ExSet_defined)
φreasoner_ML 𝒜simp_if_need %cutting (‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜simp_if_need _ _›) = ‹
fn (_, (ctxt,sequent)) => Seq.make (fn () =>
let val (bvs, goal) = Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
val (ToA, Const _ $ direction_term $ _) = PLPR_Syntax.dest_action_of' (K true) goal
val (X, Y', _) = Phi_Syntax.dest_transformation ToA
val direction = case direction_term of Const(\<^const_name>‹True›, _) => true
| Const(\<^const_name>‹False›, _) => false
| _ => raise TERM ("The direction of 𝒜simp_if_need must be a literal", [direction_term])
val (Y, ex_bound) =
case Y' of Const(\<^const_name>‹ExSet›, _) $ Abs (N, Ty,
Const(\<^const_name>‹Subjection›, _) $ (Y as Const(\<^const_name>‹φType›, _) $ Bound 0 $ _) $ _)
=> (Y, SOME (N,Ty))
| _ => (Y', NONE)
in if (if direction then Phi_CoP_Simp.is_simp_needed (Context.Proof ctxt) bvs X
else Phi_CoP_Backward_Simp.is_simp_needed (Context.Proof ctxt) (the_list ex_bound @ bvs) Y)
then SOME ((ctxt, @{thm' 𝒜simp_chk_go} RS' (ctxt, sequent)), Seq.empty)
else let val rule = if is_some ex_bound then @{thm' 𝒜simp_chk_no_need'}
else @{thm' 𝒜simp_chk_no_need}
in SOME ((ctxt, rule RS' (ctxt, sequent)), Seq.empty)
end
end)
›
φreasoner_ML 𝒜transitive_simp_if_need %cutting (‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜transitive_simp_if_need _ _›) = ‹
fn (_, (ctxt,sequent)) => Seq.make (fn () =>
let val (bvs, goal) = Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
val (ToA, Const _ $ direction_term $ _) = PLPR_Syntax.dest_action_of' (K true) goal
val (X, Y', _) = Phi_Syntax.dest_transformation ToA
val direction = case direction_term of Const(\<^const_name>‹True›, _) => true
| Const(\<^const_name>‹False›, _) => false
| _ => raise TERM ("The direction of 𝒜simp_if_need must be a literal", [direction_term])
val (Y, ex_bound) =
case Y' of Const(\<^const_name>‹ExSet›, _) $ Abs (N, Ty,
Const(\<^const_name>‹Subjection›, _) $ (Y as Const(\<^const_name>‹φType›, _) $ Bound 0 $ _) $ _)
=> (Y, SOME (N, Ty))
| _ => (Y', NONE)
in if (if direction then Phi_CoP_Simp.is_simp_needed (Context.Proof ctxt) bvs X
else Phi_CoP_Backward_Simp.is_simp_needed (Context.Proof ctxt) (the_list ex_bound @ bvs) Y)
then SOME ((ctxt, (if direction then if is_some ex_bound
then @{thm' 𝒜simp_chk_go_transitive}
else @{thm' 𝒜simp_chk_go_transitive'}
else if is_some ex_bound
then @{thm' 𝒜simp_chk_go_transitive_backward}
else @{thm' 𝒜simp_chk_go_transitive_backward'})
RS' (ctxt, sequent)), Seq.empty)
else let val rule = if is_some ex_bound then @{thm' 𝒜simp_chk_no_need'_transitive}
else @{thm' 𝒜simp_chk_no_need_transitive}
in SOME ((ctxt, rule RS' (ctxt, sequent)), Seq.empty)
end
end)
›
end
lemma [φreason default ! %φsimp_system_fallback+1
for ‹_ ⦂ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ _ 𝗌𝗎𝖻𝗃 y. _ @tag 𝒜simp' _ False›]:
‹x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T 𝗌𝗎𝖻𝗃 y. y = x @tag 𝒜simp' direction False›
unfolding Action_Tag_def
by (simp add: ExSet_defined)
lemma [φreason default ! %φsimp_system_fallback
for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒜simp' _ False›]:
‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag 𝒜simp' direction False›
unfolding Action_Tag_def
by simp
paragraph ‹Invoking CoP-simp in ToA reasoning›
ML ‹
val normalize_source = @{lemma
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X' @tag 𝒜_map_each_item (𝒜transitive_simp_if_need True False)
⟹ X' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by (clarsimp simp: Action_Tag_def Transformation_def, blast)
}
fun normalize_source_of_ToA (ctxt, sequent) =
let val (bvs, ToA) = Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
val (X, _, _) = Phi_Syntax.dest_transformation ToA
in if Phi_Syntax.exists_item_of_assertion (Phi_CoP_Simp.is_simp_needed (Context.Proof ctxt)) bvs X
then (
Phi_Reasoner.info_print ctxt 2 (K "normalizing the source assertion of the transformation") ;
case Phi_Reasoner.internal_reason NONE (SOME 1) (ctxt, normalize_source RS sequent)
of NONE => (ctxt, sequent)
| SOME (ctxt', sequent') =>
(ctxt', Conv.gconv_rule (Phi_Conv.hhf_concl_conv (conv_transformation_by_assertion_ss) ctxt') 1 sequent'))
else (ctxt, sequent)
end
fun normalize_target_of_ToA parse (ctxt, sequent) =
let val (bvs, ToA) = Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
val (Y, rule) = parse (Phi_Syntax.dest_transformation ToA)
in if Phi_CoP_Backward_Simp.is_simp_needed (Context.Proof ctxt) bvs Y
then (
Phi_Reasoner.info_print ctxt 2 (K "normalizing the target assertion of the transformation") ;
case Phi_Reasoner.internal_reason NONE (SOME 1) (ctxt, rule RS sequent)
of NONE => (ctxt, sequent)
| SOME ret => ret)
else (ctxt, sequent)
end
fun chk_target_of_ToA_requires_normalization parse_term (ctxt, sequent) =
let val (bvs, ToA) = Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
val target = parse_term (#2 (Phi_Syntax.dest_transformation ToA))
in Phi_CoP_Backward_Simp.is_simp_needed (Context.Proof ctxt) bvs target orelse
(case target
of Const(\<^const_name>‹φType›, _) $ x $ T =>
let val head = Term.head_of x
in not (is_Var head) orelse exists_subterm (fn y => y aconv head) T
end
| _ => false)
end
›
subsubsection ‹Simplification Protect›
definition [simplification_protect]:
‹φTBS_Simp_Protect X U r direction flag ≡ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r y @tag 𝒜simp' direction flag›
lemma [cong]:
‹ X ≡ X'
⟹ U ≡ U'
⟹ r ≡ r'
⟹ φTBS_Simp_Protect X U r direction flag ≡ φTBS_Simp_Protect X' U' r' direction flag ›
by simp
subsubsection ‹Extracting Pure›
lemma [φreason %extract_pure]:
‹ 𝗋ESC P A
⟹ 𝗋ESC P (A @tag 𝒜simp' direction any) ›
unfolding Action_Tag_def
by blast
lemma [φreason %extract_pure]:
‹ 𝗋EIF A P
⟹ 𝗋EIF (A @tag 𝒜simp' direction any) P ›
unfolding Action_Tag_def
by blast
subsection ‹Falling Lattice of Transformation Sub-procedures›
subsubsection ‹From ‹𝒯𝒫'› to ‹𝒯𝒫››
lemma [φreason default %ToA_falling_latice+3]:
‹ 𝗀𝗎𝖺𝗋𝖽 fst x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ May_Assign (snd x) unspec
⟹ x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y, unspec) ⦂ U ∗[False] ⊤⇩φ 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
unfolding 𝗋Guard_def Action_Tag_def
by simp
lemma [φreason default %ToA_falling_latice+2]:
‹ x ⦂ X ∗[True] Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 prod.swap x ⦂ Y ∗[True] X @tag 𝒯𝒫' ›
for X :: ‹('a::sep_ab_semigroup,'b) φ›
unfolding Action_Tag_def Cond_φProd_def φProd_def φType_def Transformation_def
by (cases x; simp add: mult.commute)
lemma [φreason default %ToA_falling_latice+1]:
‹ 𝗀𝗎𝖺𝗋𝖽 Push_Envir_Var prove_obligations_in_time True ∧⇩𝗋
Identity_Element⇩I (fst x ⦂ T) P ∧⇩𝗋
Pop_Envir_Var prove_obligations_in_time
⟹ x ⦂ T ∗[True] U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (snd x, unspec) ⦂ U ∗[False] ⊤⇩φ 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'›
for T :: ‹('c::sep_magma_1, 'x) φ›
unfolding 𝗋Guard_def Ant_Seq_def Identity_Element⇩I_def Transformation_def Action_Tag_def
by (clarsimp; fastforce)
lemma [φreason default %ToA_falling_latice]:
‹ Identity_Element⇩E (one ⦂ U)
⟹ x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (one, fst x) ⦂ U ∗[True] T @tag 𝒯𝒫'›
for T :: ‹('c::sep_magma_1, 'x) φ›
unfolding 𝗋Guard_def Ant_Seq_def Identity_Element⇩E_def Transformation_def Premise_def Action_Tag_def
by (clarsimp; force)
subsubsection ‹From ‹𝒯𝒫› to ‹𝒯𝒫'››
paragraph ‹Preliminary›
φreasoner_group SE_internal = (1000, [1000, 2000]) ‹internal›
and SE_internal_err = (10, [10, 10]) < SE_internal ‹internal›
subparagraph ‹Unital›
definition ‹SE_tail1 Cw Cr A P1 r R w W R3 P
⟷ (if Cw then (∃P2 RR. (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 RR 𝗐𝗂𝗍𝗁 P2)
∧ R3 = (if Cr then (r ⦂ R) * RR else RR)
∧ P = (P2 ∧ P1))
else P = P1 ∧ R3 = (if Cr then (r ⦂ R) * A else A))›
declare [[
φreason_default_pattern ‹SE_tail1 ?Cw ?Cr ?A ?P1 ?r ?R _ _ _ _›
⇒ ‹SE_tail1 ?Cw ?Cr ?A ?P1 ?r ?R _ _ _ _› (100)
]]
lemma [φreason %SE_internal]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 RR 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫
⟹ SE_tail1 True True A P1 r R w W ((r ⦂ R) * RR) (P2 ∧ P1) ›
unfolding SE_tail1_def Action_Tag_def
by (simp, rule exI[where x=P2], rule exI[where x=RR], simp)
lemma [φreason %SE_internal]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 RR 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫
⟹ SE_tail1 True False A P1 r R w W RR (P2 ∧ P1) ›
unfolding SE_tail1_def Action_Tag_def
by (simp, rule exI[where x=P2], simp)
lemma [φreason %SE_internal]:
‹ SE_tail1 False True A P1 r R w W ((r ⦂ R) * A) P1 ›
unfolding SE_tail1_def Action_Tag_def
by simp
lemma [φreason %SE_internal]:
‹ SE_tail1 False False A P1 r R w W A P1 ›
unfolding SE_tail1_def Action_Tag_def
by simp
lemma [φreason %SE_internal_err]:
‹ ERROR TEXT(‹ToA: condition variables are not literal› (Cw, Cr))
⟹ SE_tail1 Cw Cr A P1 r R w W A P1 ›
unfolding ERROR_def Action_Tag_def
by simp
subparagraph ‹Non-Unital›
definition ‹SE_tail Cw Cr A P1 r R
w W C R3 P
⟷ (∃P2 RR Crr.
(if Cw then (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Crr] RR 𝗐𝗂𝗍𝗁 P2) else (P2, Crr) = (True, False)) ∧
C = (Cr ∨ Crr ∨ ¬ Cw) ∧
(if Crr then if Cr then R3 = (r ⦂ R) * RR else R3 = RR
else if Cw then if Cr then R3 = (r ⦂ R) else True
else if Cr then R3 = (r ⦂ R) * A else R3 = A) ∧
P = (P2 ∧ P1)) ›
declare [[
φreason_default_pattern ‹SE_tail ?Cw ?Cr ?A ?P1 ?r ?R _ _ _ _ _›
⇒ ‹SE_tail ?Cw ?Cr ?A ?P1 ?r ?R _ _ _ _ _› (100)
]]
lemma [φreason %SE_internal]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Crr] RR 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫
⟹ ◒⇩B⇩I[True] R3 = ◒⇩B⇩I[True] (r ⦂ R) * ◒⇩B⇩I[Crr] RR @tag 𝒜merge
⟹ SE_tail True True A P1 r R w W True R3 (P2 ∧ P1) ›
unfolding SE_tail_def Action_Tag_def
by (rule exI[where x=P2]; rule exI[where x=RR]; rule exI[where x=Crr];
cases Crr; clarsimp simp: φCond_Unital_BI_Prod φCond_Unital_BI_eq_strip)
lemma [φreason %SE_internal]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Crr] RR 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫
⟹ ◒⇩B⇩I[Crr] R3 = ◒⇩B⇩I[False] ⊤ * ◒⇩B⇩I[Crr] RR @tag 𝒜merge
⟹ SE_tail True False A P1 r R w W Crr R3 (P2 ∧ P1) ›
unfolding SE_tail_def Action_Tag_def
by (rule exI[where x=P2]; rule exI[where x=RR]; rule exI[where x=Crr];
cases Crr; clarsimp simp: φCond_Unital_BI_Prod φCond_Unital_BI_eq_strip)
lemma [φreason %SE_internal]:
‹ SE_tail False True A P1 r R w W True ((r ⦂ R) * A) P1 ›
unfolding SE_tail_def
by (rule exI[where x=True]; rule; rule exI[where x=False]; clarsimp)
lemma [φreason %SE_internal]:
‹ SE_tail False False A P1 r R w W True A P1 ›
unfolding SE_tail_def
by (rule exI[where x=True]; rule; rule exI[where x=False]; clarsimp)
lemma [φreason %SE_internal_err]:
‹ ERROR TEXT(‹ToA: condition variables are not literal› (Cw, Cr))
⟹ SE_tail Cw Cr A P1 r R w W True A P1 ›
unfolding ERROR_def
by simp
paragraph ‹Boundary›
definition ‹SE_tail_Rw C⇩W A w W P2
⟷ (if C⇩W then A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗐𝗂𝗍𝗁 P2 else Identity_Element⇩I A P2) ›
declare [[
φreason_default_pattern ‹SE_tail_Rw ?C⇩W ?A _ _ _› ⇒ ‹SE_tail_Rw ?C⇩W ?A _ _ _› (100)
]]
lemma [φreason %SE_internal]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫
⟹ SE_tail_Rw True A w W P2 ›
unfolding SE_tail_Rw_def Action_Tag_def
by simp
lemma [φreason %SE_internal]:
‹ Identity_Element⇩I A P2
⟹ SE_tail_Rw False A w W P2 ›
unfolding SE_tail_Rw_def
by simp
lemma [φreason %SE_internal_err]:
‹ ERROR TEXT(‹ToA: condition variables are not literal› Cw)
⟹ SE_tail_Rw Cw A w W P2 ›
unfolding ERROR_def
by simp
paragraph ‹Rules›
lemma [φreason default %ToA_falling_latice+3]:
‹ (x, w) ⦂ T ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 yr ⦂ U ∗[C] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ if C⇩W then Identity_Element⇩E (w ⦂ W) else True
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 fst yr ⦂ U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] snd yr ⦂ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
for T :: ‹('c::sep_magma_1, 'x) φ›
unfolding Premise_def Identity_Element⇩E_def Try_def Action_Tag_def
apply (cases C; cases C⇩W; clarsimp simp add: φSome_transformation_strip φProd_expn'' φProd_expn')
apply (metis mk_elim_transformation mult_1_class.mult_1_right transformation_left_frame)
by (metis mk_elim_transformation mult_1_class.mult_1_right transformation_left_frame)
lemma [φreason default %ToA_falling_latice+3]:
‹ (x,w) ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[Cr] R 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫'
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] y' : y
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] y⇩1 : fst y'
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] r : snd y'
⟹ SE_tail1 Cw Cr A P1 r R w W R3 P
⟹ (x ⦂ T) * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩1 ⦂ U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R3 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
for A :: ‹'a::sep_monoid BI›
unfolding SE_tail1_def Action_Tag_def Simplify_def Action_Tag_def
by ((cases Cw; cases Cr;
clarsimp simp: φSome_φProd φSome_transformation_strip φProd_expn' φProd_expn'' mult.assoc[symmetric]),
metis mult.assoc transformation_left_frame transformation_right_frame transformation_trans,
metis (no_types, opaque_lifting) mult.assoc transformation_left_frame transformation_right_frame transformation_trans,
insert transformation_right_frame, blast, blast)
lemma [φreason default %ToA_falling_latice+3]:
‹ (x, w) ⦂ T ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫'
⟹ if C⇩R then Identity_Element⇩I (snd y ⦂ R) Q else Q = True
⟹ SE_tail_Rw C⇩W A w W P2
⟹ (x ⦂ T) * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 fst y ⦂ U 𝗐𝗂𝗍𝗁 P2 ∧ Q ∧ P1 @tag 𝒯𝒫 ›
for A :: ‹'a :: sep_magma_1 set›
unfolding Action_Tag_def φProd_expn' Identity_Element⇩I_def Premise_def
Transformation_def Try_def Ant_Seq_def SE_tail_Rw_def
by (cases C⇩W; cases C⇩R; clarsimp; fastforce)
lemma [φreason default %ToA_falling_latice+2 except ‹(_ :: ?'a::sep_magma_1 BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 ›]:
‹ (x, w) ⦂ T ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 yr ⦂ U ∗[C] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C⇩W
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 fst yr ⦂ U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] snd yr ⦂ R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
unfolding Premise_def Try_def Action_Tag_def
by (cases C; clarsimp simp add: φSome_transformation_strip φProd_expn'')
lemma [φreason default %ToA_falling_latice+2 except ‹(_ :: ?'a::sep_magma_1 BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ (x,w) ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[Cr] R 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫'
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] y' : y
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] y⇩1 : fst y'
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] y⇩2 : snd y'
⟹ SE_tail Cw Cr A P1 y⇩2 R w W C R3 P
⟹ (x ⦂ T) * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩1 ⦂ U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R3 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
for A :: ‹'a::sep_semigroup BI›
unfolding Action_Tag_def REMAINS_def Simplify_def Try_def SE_tail_def Simplify_def
apply clarify
apply (cases Cw; cases Cr; case_tac Crr; cases y;
simp add: φSome_φProd φSome_transformation_strip φProd_expn')
subgoal premises prems for P2 RR Crr a b
by (insert prems(5)[THEN transformation_right_frame, where R=‹x ⦂ T›]
prems(1)[THEN transformation_left_frame, where R=RR],
simp add: mult.assoc transformation_trans,
smt (verit, ccfv_threshold) Transformation_def mult.assoc prems(1) prems(5) transformation_left_frame transformation_right_frame)
using transformation_left_frame transformation_trans apply blast
subgoal premises prems for P2 RR Crr a b
by (insert prems(5)[THEN transformation_right_frame, where R=‹x ⦂ T›]
prems(1)[THEN transformation_left_frame, where R=RR],
simp add: mult.assoc transformation_trans,
metis (no_types, opaque_lifting) mult.assoc prems(1) prems(5) transformation_left_frame transformation_right_frame transformation_trans)
using transformation_left_frame transformation_trans apply blast
apply (metis mult.assoc transformation_right_frame)
using transformation_right_frame by blast
lemma [φreason default %ToA_falling_latice+2 except ‹(_ :: ?'a::sep_magma_1 BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 ›]:
‹ (x, w) ⦂ T ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫'
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[𝗌𝖺𝖿𝖾] (¬ C⇩R ∧ C⇩W)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 w ⦂ W 𝗐𝗂𝗍𝗁 P2
⟹ (x ⦂ T) * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 fst y ⦂ U 𝗐𝗂𝗍𝗁 P2 ∧ P1 @tag 𝒯𝒫 ›
for A :: ‹'a :: sep_magma set›
unfolding Action_Tag_def φProd_expn' Identity_Element⇩I_def Premise_def
Transformation_def Try_def Identity_Element⇩E_def Ant_Seq_def
by (cases C⇩W; cases C⇩R; clarsimp; blast)
lemma [φreason default %ToA_falling_latice+1]:
‹ R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ ◒⇩B⇩I[True] R'' = ◒⇩B⇩I[True] X * ◒⇩B⇩I[C⇩R] R' @tag 𝒜merge
⟹ X * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R'' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
for Y :: ‹'c::sep_ab_semigroup BI›
unfolding Action_Tag_def
by ((cases C⇩R; clarsimp),
smt (verit) φCond_Unital_BI_Prod φCond_Unital_BI_eq_strip mult.assoc mult.commute transformation_right_frame,
metis φCond_Unital_BI_eq_strip mult.commute transformation_right_frame)
lemma [φreason default %ToA_falling_latice]:
‹ Identity_Element⇩E (var_y ⦂ U)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var_y ⦂ U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 X @tag 𝒯𝒫 ›
for X :: ‹'c::sep_magma_1 BI›
unfolding Transformation_def Identity_Element⇩E_def Action_Tag_def
by (clarsimp, force)
hide_const (open) SE_tail1 SE_tail
subsection ‹Essential Reasoning Procedures›
subsubsection ‹Reflexive Transformation›
paragraph ‹When the target and the source are either alpha-equivalent or unified›
text ‹Applying reflexive transformation on alpha-equivalent couples of source and target is safe,
so be applied of high priority.
In contrast, unification by reflexive transformation is aggressive. Therefore, they are applied
only when no other rules are applicable.›
declare transformation_refl [φreason %ToA_refl for ‹?A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?T 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›,
φreason %ToA_unified_refl for ‹_ ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?U 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]
lemma [φreason default %ToA_unified_refl for ‹?A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A' 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A ›
unfolding Premise_def 𝗋Guard_def Action_Tag_def
by simp
lemma [φreason %ToA_refl for ‹?A * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (?A :: ?'c::sep_magma_1 BI) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›,
φreason default %ToA_unified_refl for ‹?A * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (?A' :: ?'c::sep_magma_1 BI) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ Identity_Element⇩I R P
⟹ A * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 P ›
for A :: ‹'c::sep_magma_1 BI›
unfolding Identity_Element⇩I_def Transformation_def Action_Tag_def
by clarsimp fastforce
lemma transformation_refl_assigning_remainder [φreason %ToA_assigning_var for ‹?A * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 ›
‹(_ ⦂ ?T) * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 ›]:
‹A * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R›
unfolding REMAINS_def Action_Tag_def
by simp
lemma [φreason default %ToA_unified_refl for ‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ A * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R›
unfolding Premise_def REMAINS_def 𝗋Guard_def Action_Tag_def
by simp
lemma transformation_refl_with_remainder [φreason %ToA_assigning_var for ‹?A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ ⦂ ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y ⦂ ?T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] ⊤›
unfolding Action_Tag_def
by simp
lemma [φreason default %ToA_unified_refl for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] ⊤›
unfolding Premise_def 𝗋Guard_def Action_Tag_def
by simp
lemma transformation_refl_assigning_W [φreason %ToA_assigning_var]:
‹x ⦂ T ∗[True] U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x, unspec) ⦂ (T ∗ U) ∗[False] ⊤⇩φ›
unfolding Action_Tag_def
by simp
lemma [φreason default %ToA_unified_refl for ‹_ ⦂ _ ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (_ ∗ _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹ x ⦂ T ∗[True] U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x, unspec) ⦂ (T ∗ U) ∗[False] ⊤⇩φ ›
unfolding Premise_def 𝗋Guard_def Action_Tag_def
by simp
lemma transformation_refl_assigning_R [φreason %ToA_assigning_var]:
‹ May_Assign (snd x) unspec
⟹ x ⦂ (T ∗ U) ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 fst x ⦂ T ∗[True] U ›
unfolding Action_Tag_def
by simp
lemma [φreason default %ToA_unified_refl for ‹_ ⦂ (_ ∗ _) ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹
May_Assign (snd x) unspec
⟹ x ⦂ (T ∗ U) ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 fst x ⦂ T ∗[True] U ›
unfolding Premise_def 𝗋Guard_def Action_Tag_def
by simp
lemma transformation_refl_with_WR [φreason %ToA_assigning_var+1]:
‹ May_Assign (snd x) unspec
⟹ x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T ∗[False] ⊤⇩φ ›
unfolding Action_Tag_def
by simp
lemma [φreason default %ToA_unified_refl+1 for ‹_ ⦂ _ ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹
May_Assign (snd x) unspec
⟹ x ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T ∗[False] ⊤⇩φ›
unfolding Action_Tag_def
by simp
lemma ToA_refls_by_T_eq:
‹ T = T'
⟹ May_Assign (snd x⇩2) unspec
⟹ x⇩2 ⦂ T ∗[False] ⊤⇩φ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x⇩2 ⦂ T' ∗[False] ⊤⇩φ ›
‹ T = T'
⟹ (x ⦂ T) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T' 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R ›
‹ T = T'
⟹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T' ›
by simp_all
paragraph ‹When the target is a schematic variable›
text ‹Schematic variables occurring in source are assigned with zeros, and is
covered by §‹Phi_BI/Bottom/Transformation_Rules››
ML ‹
fun apply_refl_by_unifying (refl, exintro', Gx, Gy) ctxt thm =
let val (vs, _, goal) = Phi_Help.leading_antecedent (Thm.prop_of thm)
val N = length vs
val (X0,Y0,_) = Phi_Syntax.dest_transformation goal
val (X, Y) = (Gx X0, Gy Y0)
val (Var V, args) = strip_comb Y
val bnos = map_filter (fn Bound i => SOME i | _ => NONE) args
val bads = subtract (op =) bnos (Term.loose_bnos X)
in if null bads
then Phi_Reasoner.single_RS refl ctxt thm
else case exintro'
of NONE => Seq.empty
| SOME exintro => let
val N_bads = length bads
val N_bnos = length bnos
val (argTys, \<^Type>‹set ‹TY››) = Term.strip_type (snd V)
val insts' = List.tabulate (N, fn i =>
let val bi = find_index (fn k => k = i) bads
val ci = find_index (fn k => k = i) bnos
in if bi <> ~1
then Bound (N_bads - 1 - bi)
else if ci <> ~1
then Bound (N_bads + N_bnos - 1 - ci)
else Term.dummy
end)
val Y'1 = subst_bounds (insts', X)
val Y'2 = fold_rev (fn j => fn TM =>
let val (name,T) = List.nth (vs, N-1-j)
in \<^Const>‹ExSet ‹T› ‹TY›› $ Abs (name, T, TM)
end) bads Y'1
val Y'3 = fold_rev (fn (_, Bound j) => (fn TM =>
let val (name,T) = List.nth (vs, N-1-j)
in Abs (name, T, TM)
end)
| (ty, _) => (fn TM => Abs ("_", ty, TM))
) (argTys ~~ args) Y'2
in Thm.instantiate (TVars.empty, Vars.make [(V, Thm.cterm_of ctxt Y'3)]) thm
|> funpow N_bads (fn th => exintro RS th)
|> Phi_Reasoner.single_RS refl ctxt
handle THM _ => Seq.empty
end
end
›
φreasoner_ML transformation_refl_var %ToA_assigning_var (‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_Y 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›) = ‹
fn (_, (ctxt,thm)) => Seq.map (pair ctxt) (apply_refl_by_unifying (
@{thm' transformation_refl[THEN Action_Tag_I[where A=𝒯𝒫]]},
SOME @{thm' ExSet_transformation_I[THEN Action_Tag_I[where A=𝒯𝒫], OF Action_Tag_D[where A=𝒯𝒫]]},
I, I
) ctxt thm) ›
φreasoner_ML transformation_refl_var_R %ToA_assigning_var (‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›) = ‹
fn (_, (ctxt,thm)) => Seq.map (pair ctxt) (apply_refl_by_unifying (
@{thm' transformation_refl_assigning_remainder[THEN Action_Tag_I[where A=𝒯𝒫]]},
SOME @{thm' ExSet_transformation_I_R[THEN Action_Tag_I[where A=𝒯𝒫], OF Action_Tag_D[where A=𝒯𝒫]]},
(fn _ $ A $ R => A), (fn _ $ A $ _ $ _ => A)
) ctxt thm) ›
φreasoner_ML transformation_refl_var_R' %ToA_assigning_var+1 (‹_ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›) = ‹
fn (_, (ctxt,thm)) => Seq.map (pair ctxt) (apply_refl_by_unifying (
@{thm' transformation_refl_with_remainder[THEN Action_Tag_I[where A=𝒯𝒫]]},
SOME @{thm' ExSet_transformation_I_R[THEN Action_Tag_I[where A=𝒯𝒫], OF Action_Tag_D[where A=𝒯𝒫]]},
I, (fn _ $ A $ _ $ _ => A)
) ctxt thm) ›
text ‹Here, we assign the semantics of schematic variables occurring in targets and sources to be,
a wild-card for any single separation item.›
declare transformation_refl_assigning_W [φreason %ToA_assigning_var for ‹_ ⦂ ?var ∗[True] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (_ ∗ _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]
transformation_refl_assigning_R [φreason %ToA_assigning_var for ‹_ ⦂ (_ ∗ _) ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?var ∗[True] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]
transformation_refl_with_WR [φreason %ToA_assigning_var+1 for ‹_ ⦂ ?var ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
‹_ ⦂ _ ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ ?var ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]
text ‹
TODO: move me!
NToA procedure addresses the transformation between any-to-many φ-type items.
Separation Extraction addresses that from many to one φ-type item.
The φ-type themselves should provide the rules for one-to-one transformations, as they are primitive.
Transformation Functor presented later provides an automation for this.
However, a small supplementary is one-to-one with remainders.
For unital algebras, the issue is easy as we can always force yielding remainders.
For non-semigroups, after a reasoning branch splitting the cases for having remainder or not,
the issue reduces immediately.
For associative but non-unital algebras, a bit of work is required.
›
subsubsection ‹Varify Target Object›
lemma [φreason default %ToA_varify_target_object for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y' ⦂ _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]:
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r y @tag 𝒜transitive_simp_if_need False False
⟹ Object_Equiv U eq
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 P : (∀y'. r y' ⟶ eq y' y)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫 ›
unfolding Action_Tag_def Transformation_def Premise_def Object_Equiv_def Simplify_def
by clarsimp metis
lemma [φreason default %ToA_varify_target_object for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var_y' ⦂ _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. r y @tag 𝒜transitive_simp_if_need False False
⟹ Object_Equiv U eq
⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 P : (∀y'. r y' ⟶ eq y' y)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫›
unfolding Action_Tag_def Transformation_def Premise_def Object_Equiv_def Simplify_def
by (cases C; clarsimp; metis)
subsubsection ‹Basic Transformation Rules›
paragraph ‹Plainize›
lemma [φreason %ToA_normalizing]:
" T1 * (T2 * R) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ (T1 * T2) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P"
for R :: ‹'a::sep_semigroup BI›
unfolding mult.assoc .
lemma [φreason %ToA_normalizing]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X1 * (X2 * R) 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (X1 * X2) * R 𝗐𝗂𝗍𝗁 P"
for R :: ‹'a::sep_semigroup BI›
unfolding mult.assoc .
lemma [φreason %ToA_normalizing]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X1 * (X2 * X3) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (X1 * X2) * X3 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P"
for R :: ‹'a::sep_semigroup BI›
unfolding mult.assoc .
paragraph ‹Splitting Separation Assertion in Target›
definition ‹SP_TGT C X Y C⇩R R P (tag::bool) ⟷
(if C then (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P)
else Identity_Element⇩E Y ∧ (P,C⇩R,R) = (True, False, ⊤)) ›
φreasoner_group SP_TGT = (1010, [1000, 1030]) ‹›
lemma [φreason %SP_TGT for ‹SP_TGT True _ _ _ _ _ True›
‹SP_TGT ?var _ _ _ _ _ True›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ SP_TGT True X Y C⇩R R P True ›
unfolding SP_TGT_def Action_Tag_def
by simp
lemma [φreason %SP_TGT for ‹SP_TGT True _ _ _ _ _ False›
‹SP_TGT ?var _ _ _ _ _ False›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ SP_TGT True X Y C⇩R R P False ›
unfolding SP_TGT_def Action_Tag_def
by simp
lemma [φreason %SP_TGT+10 for ‹SP_TGT True _ _ False ⊤ _ True›
‹SP_TGT ?var _ _ False ⊤ _ True›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ SP_TGT True X Y False ⊤ P True ›
unfolding SP_TGT_def Action_Tag_def
by simp
lemma [φreason %SP_TGT+10 for ‹SP_TGT True _ _ False ⊤ _ False›
‹SP_TGT ?var _ _ False ⊤ _ False›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ SP_TGT True X Y False ⊤ P False ›
unfolding SP_TGT_def Action_Tag_def
by simp
lemma [φreason %SP_TGT for ‹SP_TGT False _ _ _ _ _ _› ]:
‹ Identity_Element⇩E Y
⟹ SP_TGT False X Y False ⊤ True Any›
unfolding SP_TGT_def
by simp
lemma [φreason %SP_TGT-10 for ‹SP_TGT _ _ _ _ _ _ _›]:
‹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[mode_literal] C' : C
⟹ SP_TGT C' X Y C⇩R R P Any
⟹ SP_TGT C X Y C⇩R R P Any ›
unfolding SP_TGT_def Simplify_def
by simp
lemma [φreason %ToA_splitting_target except ‹(_ :: ?'a::sep_magma_1 BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
" A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C⇩R
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P1 ⟶ (R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X * Y 𝗐𝗂𝗍𝗁 P1 ∧ P2 @tag 𝒯𝒫"
unfolding Action_Tag_def REMAINS_def Transformation_def split_paired_All Action_Tag_def Premise_def
by (cases C⇩R; clarsimp; force)
lemma [φreason %ToA_splitting_target]:
" A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P1 ⟶ (SP_TGT C⇩R R Y False ⊤ P2 True)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X * Y 𝗐𝗂𝗍𝗁 P1 ∧ P2 @tag 𝒯𝒫 "
for A :: ‹'a::sep_magma_1 BI›
unfolding Action_Tag_def REMAINS_def Transformation_def split_paired_All Action_Tag_def Premise_def
Identity_Element⇩E_def Ant_Seq_def SP_TGT_def
by (cases C⇩R; clarsimp; force)
lemma [φreason %ToA_splitting_target except ‹(_ :: ?'a::sep_magma_1 BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
" A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R1 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C⇩R
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P1 ⟶ (R1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R' 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X * Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R' 𝗐𝗂𝗍𝗁 P1 ∧ P2 @tag 𝒯𝒫 "
for A :: ‹'a::sep_semigroup BI›
unfolding Action_Tag_def REMAINS_def Transformation_def split_paired_All Action_Tag_def Premise_def
by (cases C; clarsimp; metis sep_disj_multD1 sep_disj_multI1 sep_mult_assoc)
lemma [φreason %ToA_splitting_target]:
" A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R1 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P1 ⟶ SP_TGT C⇩R R1 Y C R' P2 True
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X * Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R' 𝗐𝗂𝗍𝗁 P1 ∧ P2 @tag 𝒯𝒫 "
for A :: ‹'a::{sep_semigroup, sep_magma_1} BI›
unfolding REMAINS_def Transformation_def split_paired_All Action_Tag_def Premise_def
Identity_Element⇩E_def Ant_Seq_def SP_TGT_def
by ((cases C; cases C⇩R; clarsimp),
metis sep_disj_multD1 sep_disj_multI1 sep_mult_assoc',
blast,
metis mult_1_class.mult_1_right sep_magma_1_left)
lemma [φreason %ToA_splitting_target+1 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ * _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
" A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R1 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P1 ⟶ (R1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R' 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫)
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X * Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R' 𝗐𝗂𝗍𝗁 P1 ∧ P2 @tag 𝒯𝒫 "
for A :: ‹'a::{sep_semigroup, sep_magma_1} BI›
unfolding Premise_def Action_Tag_def
by (simp add: mult.assoc transformation_left_frame transformation_trans)
subsubsection ‹Entry Point of Transformation Reasoning›
setup ‹Config.put_global (Phi_Syntax.enable_auto_chk_and_conv) false›
paragraph ‹Major Implementation›
subparagraph ‹Short-cuts›
lemma [φreason %ToA_refl for ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?X 𝗐𝗂𝗍𝗁 ?P›
‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?var 𝗐𝗂𝗍𝗁 ?P›]:
‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X›
unfolding Action_Tag_def using transformation_refl .
lemma [φreason %ToA_red for ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗌𝗎𝖻𝗃 True 𝗐𝗂𝗍𝗁 ?P›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗌𝗎𝖻𝗃 True 𝗐𝗂𝗍𝗁 P ›
unfolding Action_Tag_def by simp
lemma [φreason %ToA_normalizing for ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Any
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y ›
unfolding Action_Tag_def
by (simp add: transformation_weaken)
subparagraph ‹ML›
ML ‹
val augment_ToA_by_implication = Attrib.setup_config_bool \<^binding>‹augment_ToA_by_implication› (K false)
val under_NToA_ctxt = Config.declare_bool ("under_NToA_ctxt", ⌂) (K false)
structure ToA_Hooks = Hooks (
type arg = {deep: bool}
type state = context_state
)
val NToA_init_having_Q = @{lemma
‹ X 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Q
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫›
by (clarsimp simp: 𝗋EIF_def Simplify_def Identity_Element⇩I_def Satisfiable_def Premise_def
Action_Tag_def Transformation_def, blast)}
›
φreasoner_ML ToR_Entry_Point 2000 (‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?Y 𝗐𝗂𝗍𝗁 ?var_P›) = ‹
fn (_, (ctxt,sequent)) => Seq.make (fn () =>
let val sequent = skolemize_transformation ctxt sequent
val (ctxt, sequent) = normalize_source_of_ToA (ctxt, sequent)
val sequent = @{thm' Action_Tag_D[where A=‹𝒯𝒫›]} RS sequent
val sequent = if Config.get ctxt augment_ToA_by_implication
then NToA_init_having_Q RS sequent
else sequent
in SOME ((ctxt,sequent), Seq.empty)
end
)›
setup ‹Config.put_global Phi_Syntax.enable_auto_chk_and_conv true›
lemma ToA_splitting_source_no_remainder_first
[no_atp, φreason %ToA_splitting_source except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (_ :: ?'a :: sep_semigroup set) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
" C = False ∧⇩𝗋 (A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫) ∨⇩c⇩u⇩t
(C,P) = (True, P1 ∧ P2) ∧⇩𝗋 (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P1 @tag 𝒯𝒫) ∧⇩𝗋
(𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P1 ⟶ (B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R 𝗐𝗂𝗍𝗁 P2 @tag 𝒯𝒫))
⟹ A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Orelse_shortcut_def Transformation_def REMAINS_def Premise_def Ant_Seq_def Action_Tag_def
by clarsimp blast
subsection ‹Supplementary Transformations›
subsubsection ‹Supplementary for Ex \& Conj \label{supp-ex-conj}›
ML ‹fun ToA_ex_intro_reasoning (ctxt,sequent) =
let val (_, X'', _) = Phi_Syntax.dest_transformation (Thm.major_prem_of sequent)
fun parse (Const(\<^const_name>‹ExSet›, \<^Type>‹fun \<^Type>‹fun ty _› _›) $ X) = (false, ty, X)
| parse (Const(\<^const_name>‹REMAINS›, _) $ (Const(\<^const_name>‹ExSet›, \<^Type>‹fun \<^Type>‹fun ty _› _›) $ X) $ _ $ _)
= (true, ty, X)
| parse X = parse (Envir.beta_eta_contract X)
val (has_focus, _, X'1) = parse X''
val X = case X'1 of Abs (_, _, X) => X | X => Term.incr_boundvars 1 X $ Bound 0
val ex_var_is_in_obj_only = Phi_Syntax.forall_item_of_assertion_blv (fn (_,lv) =>
(fn (Const(\<^const_name>‹φType›, _) $ _ $ T) => not (Term.loose_bvar1 (T, lv))
| A => not (Term.loose_bvar1 (A, lv)))) []
val rule0 = if has_focus
then if ex_var_is_in_obj_only X
then @{thm' ExSet_transformation_I_R[where x=‹id c› for c,
OF Action_Tag_D[where A=‹𝒯𝒫›], THEN Action_Tag_I[where A=‹𝒯𝒫›]]}
else @{thm' ExSet_transformation_I_R[
OF Action_Tag_D[where A=‹𝒯𝒫›], THEN Action_Tag_I[where A=‹𝒯𝒫›]]}
else if ex_var_is_in_obj_only X
then @{thm' ExSet_transformation_I[where x=‹id c› for c,
OF Action_Tag_D[where A=‹𝒯𝒫›], THEN Action_Tag_I[where A=‹𝒯𝒫›]]}
else @{thm' ExSet_transformation_I[
OF Action_Tag_D[where A=‹𝒯𝒫›], THEN Action_Tag_I[where A=‹𝒯𝒫›]]}
in SOME ((ctxt, rule0 RS sequent), Seq.empty)
end›
φreasoner_ML ToA_ex_intro default ! %ToA_inst_qunat ( ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ExSet _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
| ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ExSet _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› )
= ‹fn stat => Seq.make (fn () => ToA_ex_intro_reasoning (snd stat))›
φreasoner_ML NToA_conj_src ! %ToA_branches (‹_ ∧⇩B⇩I _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›) = ‹fn (_, (ctxt,sequent)) => Seq.make (fn () =>
let val tail = (case Phi_Syntax.dest_transformation (Thm.major_prem_of sequent)
of (_, Const(\<^const_name>‹ExSet›, _) $ X, _) =>
if Term.exists_Const (fn (\<^const_name>‹Additive_Conj›, _) => true
| _ => false) X
then Seq.make (fn () => ToA_ex_intro_reasoning (ctxt,sequent))
else Seq.empty
| _ => Seq.empty)
in SOME ((ctxt, @{thm' NToA_conj_src_A
[OF Action_Tag_D[where A=‹𝒯𝒫›], THEN Action_Tag_I[where A=‹𝒯𝒫›]]} RS sequent),
Seq.make (fn () => SOME ((ctxt, @{thm' NToA_conj_src_B
[OF Action_Tag_D[where A=‹𝒯𝒫›], THEN Action_Tag_I[where A=‹𝒯𝒫›]]} RS sequent), tail)))
end
)›
subsubsection ‹Evaluations›
lemma [φreason %ToA_red]:
‹ (y,x) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ prod.swap (x,y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ (f x, y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ apfst f (x,y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ (x, f y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ apsnd f (x,y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ fst (x,y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ y ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ snd (x,y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ (x, z) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (fst (x,y), z) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ (y, z) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (snd (x,y), z) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ (x, y) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (x, fst (y, z)) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ (x, z) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (x, snd (y, z)) ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
subsubsection ‹Let›
lemma [φreason %ToA_red]:
" T x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P
⟹ Let x T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P"
unfolding Let_def .
lemma [φreason %ToA_red]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U x 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Let x U 𝗐𝗂𝗍𝗁 P"
unfolding Let_def .
lemma [φreason %ToA_red]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U x 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Let x U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P"
unfolding Let_def .
subsubsection ‹Case Prod›
φreasoner_group ToA_red_caseprod =
(%ToA_red, [%ToA_red, %ToA_red+10]) for (‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_prod _ _ 𝗐𝗂𝗍𝗁 _›, ‹case_prod _ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _›)
‹Transformations reducing ‹case_prod››
lemma [φreason %ToA_red_caseprod+10]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x y 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_prod f (x,y) 𝗐𝗂𝗍𝗁 P"
by simp
lemma [φreason %ToA_red_caseprod+10]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_prod f (x,y) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P"
by simp
lemma [φreason %ToA_red_caseprod+10]:
" A x y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ case_prod A (x,y) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P"
by simp
lemma [φreason %ToA_red_caseprod]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f (fst xy) (snd xy) 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_prod f xy 𝗐𝗂𝗍𝗁 P"
unfolding Transformation_def
by (cases xy; simp)
lemma [φreason %ToA_red_caseprod]:
" T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f (fst xy) (snd xy) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_prod f xy 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P"
unfolding Transformation_def
by (cases xy; cases C; simp)
lemma [φreason %ToA_red_caseprod]:
" A (fst xy) (snd xy) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ case_prod A xy 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P"
by (cases xy; simp)
subsubsection ‹Conditional Branch›
paragraph ‹Normalization›
lemma [φreason %ToA_normalizing]:
‹ If C (x ⦂ A) (x ⦂ B) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ If C A B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
by (cases C; simp)
text ‹\<^term>‹x ⦂ (If C T U) ∗[C⇩W] W› is not reduced because the ‹C⇩W› and ‹W› have to be specially assigned.›
lemma [φreason %ToA_normalizing]:
‹ If C ((x ⦂ A) * W) ((x ⦂ B) * W) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ (x ⦂ If C A B) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P›
by (cases C; simp)
lemma [φreason %ToA_normalizing]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If C (x ⦂ A) (x ⦂ B) 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x ⦂ If C A B 𝗐𝗂𝗍𝗁 P›
by (cases C; simp)
paragraph ‹Reduction for constant boolean condition›
subparagraph ‹Source›
lemma NToA_cond_source_A[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ (if C then A else B) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P›
unfolding Action_Tag_def Premise_def 𝗋Guard_def
by (simp add: Transformation_def distrib_left)
lemma NToA_cond_source_B[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ (if C then A else B) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P›
unfolding Action_Tag_def Premise_def 𝗋Guard_def
by (simp add: Transformation_def distrib_left)
lemma NToA_cond_source_A_ty[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ x ⦂ T ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ (if C then T else U) ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P›
unfolding Action_Tag_def Premise_def 𝗋Guard_def
by (simp add: Transformation_def distrib_left)
lemma NToA_cond_source_B_ty[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ x ⦂ U ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P
⟹ x ⦂ (if C then T else U) ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P›
unfolding Action_Tag_def Premise_def 𝗋Guard_def
by (simp add: Transformation_def distrib_left)
subparagraph ‹Target›
lemma NToA_cond_target_A[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then A else B) 𝗐𝗂𝗍𝗁 P›
unfolding Premise_def 𝗋Guard_def
by simp
lemma NToA_cond_target_B[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then A else B) 𝗐𝗂𝗍𝗁 P›
unfolding Premise_def 𝗋Guard_def
by simp
lemma NToA_cond_target_A'[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then A else B) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P›
unfolding Premise_def 𝗋Guard_def
by simp
lemma NToA_cond_target_B'[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then A else B) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P›
unfolding Premise_def 𝗋Guard_def
by simp
lemma NToA_cond_target_A_ty[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ T ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (if C then T else U) ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P›
unfolding Premise_def 𝗋Guard_def
by simp
lemma NToA_cond_target_B_ty[φreason %ToA_red]:
‹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (if C then T else U) ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P›
unfolding Premise_def 𝗋Guard_def
by simp
paragraph ‹When the condition boolean is a variable›
text ‹The condition should be regarded as an output, and the reasoning process assigns which
the branch that it chooses to the output condition variable.›
subparagraph ‹Normalizing›
lemma [φreason %ToA_red for ‹If (id ?var) _ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ If C T U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ If (id C) T U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
unfolding Action_Tag_def
by simp
lemma [φreason %ToA_red for ‹_ ⦂ If (id ?var) _ _ ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹ x ⦂ If C T U ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ x ⦂ If (id C) T U ∗[C⇩W] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'›
unfolding Action_Tag_def
by simp
lemma [φreason %ToA_red for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If (id ?var) _ _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If C A B 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If (id C) A B 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
by simp
lemma [φreason %ToA_red for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (If (id ?var) _ _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫' ›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (If C A B) ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (If (id C) A B) ∗[C⇩R] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫' ›
by simp
subparagraph ‹Source›
text ‹the ‹id ?x› here is the protector generated by instantiating existence in target.›
declare [[φreason ! %ToA_branches NToA_cond_source_A NToA_cond_source_B
for ‹(if ?var_condition then ?A else ?B) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?X 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫›]]
hide_fact NToA_cond_source_A NToA_cond_source_B
declare [[φreason ! %ToA_branches NToA_cond_source_A_ty NToA_cond_source_B_ty
for ‹_ ⦂ (if ?var then _ else _) ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]]
hide_fact NToA_cond_source_A_ty NToA_cond_source_B_ty
subparagraph ‹Target›
declare [[φreason ! %ToA_branches NToA_cond_target_A NToA_cond_target_B
for ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if ?var_condition then ?A else ?B) 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫› ]]
hide_fact NToA_cond_target_A NToA_cond_target_B
declare [[φreason ! %ToA_branches NToA_cond_target_B' NToA_cond_target_A'
for ‹?X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if ?var_condition then ?A else ?B) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 ?P @tag 𝒯𝒫› ]]
hide_fact NToA_cond_target_A' NToA_cond_target_B'
declare [[φreason ! %ToA_branches NToA_cond_target_A_ty NToA_cond_target_B_ty
for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (if ?var then _ else _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'› ]]
hide_fact NToA_cond_target_A_ty NToA_cond_target_B_ty
paragraph ‹Case Split›
φreasoner_group ToA_splitting_If = (%ToA_splitting, [%ToA_splitting, %ToA_splitting+1])
for (‹If C A B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y›, ‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If C A B›)
in ToA_splitting
‹ToA splitting ‹If› in either source or target, into two sub-goals.›
subparagraph ‹Source›
lemma ToA_cond_branch_src:
‹ Y = If C Ya Yb
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ If C A B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
unfolding Action_Tag_def
by (cases C; simp add: Premise_def Orelse_shortcut_def)
lemma ToA_cond_branch_src_R:
‹ Y = If C Ya Yb
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Ca] Ra 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cb] Rb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ If C A B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[If C Ca Cb] If C Ra Rb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
by (cases C; simp add: Premise_def Orelse_shortcut_def)
lemma [φreason %ToA_splitting_If]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ (x ⦂ T⇩a ∗[C⇩W⇩a] W⇩a 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩a ⦂ U ∗[Ca] Ra 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟹ (x ⦂ T⇩b ∗[C⇩W⇩b] W⇩b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩b ⦂ U ∗[Cb] Rb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫'))
⟹ x ⦂ (If C T⇩a T⇩b) ∗[If C C⇩W⇩a C⇩W⇩b] (If C W⇩a W⇩b) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If C y⇩a y⇩b ⦂ U ∗[If C Ca Cb] If C Ra Rb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫' ›
unfolding Try_def
by (cases C; simp add: Premise_def Orelse_shortcut_def)
ML ‹
fun reasoner_ToA_conditioned_subgoals_If ctxt'N (vars,Y,RHS) =
let val (C, Ya, Yb) = Phi_Help.dest_triop_c \<^const_name>‹If› RHS
val C_term = Thm.term_of C
val Ya_s = map (fn ((N,i),ty) => Thm.var ((N,i+2), Thm.ctyp_of ctxt'N ty)) vars
val Yb_s = map (fn ((N,i),ty) => Thm.var ((N,i+3), Thm.ctyp_of ctxt'N ty)) vars
val Y_s = map2 (fn a => fn b =>
let val ty = Thm.typ_of_cterm a
in Thm.apply (Thm.apply (
Thm.apply (Thm.cterm_of ctxt'N \<^Const>‹If ty›) C
) a
) b
end) Ya_s Yb_s
val Ya' = Thm.instantiate_cterm (TVars.empty, Vars.make (vars ~~ Ya_s)) Y
val Yb' = Thm.instantiate_cterm (TVars.empty, Vars.make (vars ~~ Yb_s)) Y
fun mk_inst ctm Y =
case Thm.term_of ctm
of _ $ Free _ => mk_inst (Thm.dest_fun ctm) (Thm.lambda (Thm.dest_arg ctm) Y)
| Var v => (v, Y)
| _ => error "BUG: reasoner_ToA_conditioned_subgoals"
in (Vars.make (mk_inst Ya Ya' :: mk_inst Yb Yb' :: (vars ~~ Y_s)), C_term)
end
›
lemma If_distrib_fx:
‹(If C fa fb) (If C va vb) ≡ (If C (fa va) (fb vb))›
unfolding atomize_eq
by (cases C; simp)
lemma If_distrib_arg:
‹(If C fa fb) a ≡ (If C (fa a) (fb a))›
unfolding atomize_eq
by (cases C; simp)
φreasoner_ML ‹ML (If C A B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)› %ToA_splitting_If
( ‹If _ _ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
| except ‹If ?var _ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›)
= ‹Phi_Reasoners.reasoner_ToA_conditioned_subgoals
(@{thm' ToA_cond_branch_src}, @{thm' ToA_cond_branch_src_R},
(true, @{thms' if_cancel[folded atomize_eq]}, @{thms' if_True if_False}),
reasoner_ToA_conditioned_subgoals_If, \<^context>) o snd›
subparagraph ‹Target›
lemma [φreason %ToA_splitting_If except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if ?var then _ else _) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then A else B) 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
by (cases C; simp add: Premise_def Orelse_shortcut_def)
lemma [φreason %ToA_splitting_If except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if ?var then _ else _) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Ca] Ra 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cb] Rb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then A else B) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[If C Ca Cb] If C Ra Rb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
by (cases C; simp add: Premise_def Orelse_shortcut_def)
lemma [φreason %ToA_splitting_If except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (if ?var then _ else _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩a ⦂ T ∗[Ca] Ra 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩b ⦂ U ∗[Cb] Rb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫'))
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then y⇩a else y⇩b) ⦂ (if C then T else U) ∗[If C Ca Cb] If C Ra Rb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫' ›
unfolding Try_def Premise_def Orelse_shortcut_def
by (cases C; simp)
subsubsection ‹Conditioned Remains›
paragraph ‹When the conditional boolean is fixed›
φreasoner_group ToA_constant_remains = (%ToA_splitting_source, [%ToA_splitting_source-4,%ToA_splitting_source+2])
for (‹X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R 𝗐𝗂𝗍𝗁 P›)
in ToA ‹›
lemma [φreason default %ToA_constant_remains-2 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] ?var 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C⇩R
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
unfolding Premise_def
by simp
lemma [φreason default %ToA_constant_remains-1 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] (?var::?'c::sep_magma_1 BI) 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C⇩R] R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ if C⇩R then R = R' else R = 1
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
for R :: ‹'c :: sep_magma_1 BI›
by (cases C⇩R; simp)
lemma [φreason default %ToA_constant_remains-3 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y * R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[True] R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
by simp
lemma [φreason %ToA_normalizing for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] ⊤ 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
by simp
paragraph ‹Reduction›
subparagraph ‹Source›
lemma ToA_CR_src_A [φreason %ToA_red]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ Y * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Transformation_def split_paired_All 𝗋Guard_def Premise_def Action_Tag_def
by simp
lemma ToA_CR_src_B [φreason %ToA_red+10 for ‹_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[?var] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 "
unfolding Transformation_def split_paired_All 𝗋Guard_def Premise_def Action_Tag_def
by simp
lemma ToA_CR_src_A' [φreason %ToA_red]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ (Y * R) * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ (Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 "
unfolding Transformation_def split_paired_All 𝗋Guard_def Premise_def Action_Tag_def
by simp
lemma ToA_CR_src_B' [φreason %ToA_red+10 for ‹(_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] _) * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹(_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[?var] _) * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ Y * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ (Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) * A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding Transformation_def split_paired_All 𝗋Guard_def Premise_def Action_Tag_def
by simp
subparagraph ‹Target›
lemma ToA_CR_target_A [φreason %ToA_red]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] C
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X * R 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 "
unfolding 𝗋Guard_def Premise_def
by simp
lemma ToA_CR_target_B [φreason %ToA_red+10 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[False] _) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[?var] _) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ C
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (X 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫"
unfolding 𝗋Guard_def Premise_def Action_Tag_def
by simp
paragraph ‹Case Split›
subparagraph ‹Source›
lemma ToA_cond_remain_src:
‹ Y = If C Ya Yb
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
by (cases C; simp add: Orelse_shortcut_def Premise_def)
lemma ToA_cond_remain_src_R:
‹ Y = If C Ya Yb
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (A * B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Ca] Ra 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cb] Rb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[If C Ca Cb] If C Ra Rb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
by (cases C; simp add: Orelse_shortcut_def Premise_def)
lemma ToA_cond_remain_src_W:
‹ Y = If C Ya Yb
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (A * B * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (A * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
by (cases C; simp add: Orelse_shortcut_def Premise_def)
lemma ToA_cond_remain_src_WR:
‹ Y = If C Ya Yb
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (A * B * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Ca] Ra 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (A * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cb] Rb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[If C Ca Cb] If C Ra Rb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫 ›
by (cases C; simp add: Orelse_shortcut_def Premise_def)
φreasoner_ML ‹ML (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P)› %ToA_splitting (‹_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›)
= ‹Phi_Reasoners.reasoner_ToA_conditioned_subgoals
(@{thm' ToA_cond_remain_src}, @{thm' ToA_cond_remain_src_R},
(true, @{thms' if_cancel[folded atomize_eq]}, @{thms' if_True if_False}),
reasoner_ToA_conditioned_subgoals_If, \<^context>) o snd›
φreasoner_ML ‹ML ((A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] B) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P)› %ToA_splitting (‹(_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _) * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›)
= ‹Phi_Reasoners.reasoner_ToA_conditioned_subgoals
(@{thm' ToA_cond_remain_src_W}, @{thm' ToA_cond_remain_src_WR},
(true, @{thms' if_cancel[folded atomize_eq]}, @{thms' if_True if_False}),
reasoner_ToA_conditioned_subgoals_If, \<^context>) o snd›
subparagraph ‹Target›
lemma [φreason %ToA_splitting except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[?var] _) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y * R 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[CCa] RRa 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟶ (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[CCb] RRb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫))
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[If C CCa CCb] If C RRa RRb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫›
unfolding Premise_def Ant_Seq_def Orelse_shortcut_def
by (cases C; simp)
paragraph ‹When the condition boolean is a variable›
subparagraph ‹Normalizing›
lemma [φreason %ToA_red for ‹_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[id ?var] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[V] R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[id V] R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
by simp
lemma [φreason %ToA_red for ‹(_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[id ?var] _) * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[V] R) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[id V] R) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
by simp
lemma [φreason %ToA_red for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[id ?var] _) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[V] R) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[id V] R) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫 ›
by simp
subparagraph ‹Source›
declare [[φreason ! %ToA_branches ToA_CR_src_A ToA_CR_src_B
for ‹_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[?var] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]]
hide_fact ToA_CR_src_A ToA_CR_src_B
declare [[φreason ! %ToA_branches ToA_CR_src_A' ToA_CR_src_B'
for ‹(_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[?var] _) * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]]
hide_fact ToA_CR_src_A' ToA_CR_src_B'
subparagraph ‹Target›
declare [[φreason ! %ToA_branches ToA_CR_target_A ToA_CR_target_B
for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (_ 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[?var] _) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› ]]
hide_fact ToA_CR_target_A ToA_CR_target_B
subsubsection ‹Type-embedding of Conditioned Remains›
paragraph ‹Reduction›
subparagraph ‹Source›
lemma ToA_CRφ_src_A [φreason %ToA_red]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] CC
⟹ x ⦂ (T1 ∗ T2) ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ x ⦂ (T1 ∗[CC] T2) ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'"
unfolding Transformation_def split_paired_All 𝗋Guard_def Premise_def
by simp
lemma ToA_CRφ_src_B [φreason %ToA_red+10 for ‹_ ⦂ (_ ∗[False] _) ∗ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
‹_ ⦂ (_ ∗[?var] _) ∗ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ CC
⟹ (fst (fst x), snd x) ⦂ T1 ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ x ⦂ (T1 ∗[CC] T2) ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'"
unfolding Transformation_def split_paired_All 𝗋Guard_def Premise_def Action_Tag_def
by simp
subparagraph ‹Target›
lemma ToA_CRφ_target_A [φreason %ToA_red]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] CC
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (U ∗ R) ∗[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (U ∗[CC] R) ∗[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'"
unfolding 𝗋Guard_def Premise_def
by simp
lemma ToA_CRφ_target_B [φreason %ToA_red+10 for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (_ ∗[False] _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (_ ∗[?var] _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
" 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[NO_INST] ¬ CC
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U ∗[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
⟹ Y 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ((fst y, unspec), snd y) ⦂ (U ∗[CC] R) ∗[C] R2 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'"
unfolding 𝗋Guard_def Premise_def
by (cases C; simp add: φProd_expn' φProd_expn'')
paragraph ‹Case Split›
subparagraph ‹Source›
lemma [φreason %ToA_splitting]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (y⇩a,P,Cwa,W⇩a,C⇩R⇩a,R⇩a,y⇩a) = (unspec, False, True, ⊥⇩φ, True, ⊥⇩φ, unspec) ∨⇩c⇩u⇩t
(x ⦂ (T1 ∗ T2) ∗[Cwa] W⇩a 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩a ⦂ U ∗[C⇩R⇩a] R⇩a 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (y⇩b,Q,Cwb,W⇩b,C⇩R⇩b,R⇩b,y⇩b) = (unspec, False, True, ⊥⇩φ, True, ⊥⇩φ, unspec) ∨⇩c⇩u⇩t
(apfst fst x ⦂ T1 ∗[Cwb] W⇩b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩b ⦂ U ∗[C⇩R⇩b] R⇩b 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫'))
⟹ x ⦂ (T1 ∗[C] T2) ∗[If C Cwa Cwb] If C W⇩a W⇩b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 If C y⇩a y⇩b ⦂ U ∗[If C C⇩R⇩a C⇩R⇩b] If C R⇩a R⇩b 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫' ›
unfolding Orelse_shortcut_def Premise_def Ant_Seq_def
by (cases C; simp ; cases Cwb; simp add: φProd_expn'' φProd_expn')
subparagraph ‹Target›
lemma [φreason %ToA_splitting except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (_ ∗[?var] _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 C ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (y⇩a,CCa,RRa,P) = (unspec,True,⊥⇩φ,False) ∨⇩c⇩u⇩t
(X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩a ⦂ (U ∗ R) ∗[CCa] RRa 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'))
⟹ (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ C ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (y⇩b,CCb,RRb,Q) = (unspec,True,⊥⇩φ,False) ∨⇩c⇩u⇩t
(X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩b ⦂ U ∗[CCb] RRb 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫'))
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (if C then y⇩a else apfst (λx. (x, unspec)) y⇩b) ⦂ (U ∗[C] R) ∗[If C CCa CCb] If C RRa RRb 𝗐𝗂𝗍𝗁 If C P Q @tag 𝒯𝒫'›
unfolding Ant_Seq_def Orelse_shortcut_def Premise_def
by (cases C; simp; cases CCb; simp add: φProd_expn' φProd_expn'')
paragraph ‹When the condition boolean is a variable›
subparagraph ‹Source›
declare [[φreason ! %ToA_branches ToA_CRφ_src_A ToA_CRφ_src_B
for ‹_ ⦂ (_ ∗[?var] _) ∗[_] _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]]
hide_fact ToA_CRφ_src_A ToA_CRφ_src_B
subparagraph ‹Target›
declare [[φreason ! %ToA_branches ToA_CRφ_target_A ToA_CRφ_target_B
for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (_ ∗[?var] _) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'› ]]
hide_fact ToA_CRφ_target_A ToA_CRφ_target_B
subsubsection ‹Case Sum›
paragraph ‹Reduction›
subparagraph ‹Target›
lemma ToA_case_sum_target_L[φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A x 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B (Inl x) 𝗐𝗂𝗍𝗁 P ›
by simp
lemma ToA_case_sum_target_L'[φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A x 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B (Inl x) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ›
by simp
lemma ToA_case_sum_target_L_ty[φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U⇩a c ∗[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ case_sum U⇩a U⇩b (Inl c) ∗[C] R 𝗐𝗂𝗍𝗁 P ›
by simp
lemma ToA_case_sum_target_R[φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B x 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B (Inr x) 𝗐𝗂𝗍𝗁 P ›
by simp
lemma ToA_case_sum_target_R'[φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B x 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B (Inr x) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P ›
by simp
lemma ToA_case_sum_target_R_ty[φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U⇩b c ∗[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ case_sum U⇩a U⇩b (Inr c) ∗[C] R 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B x 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B (fst (x, y)) 𝗐𝗂𝗍𝗁 P ›
by simp
subparagraph ‹Source›
lemma [φreason %ToA_red]:
‹ A x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ case_sum A B (Inl x) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ B x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ case_sum A B (Inr x) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ A x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ case_sum A B (Inl x) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ B x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ case_sum A B (Inr x) * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
lemma [φreason %ToA_red]:
‹ case_sum A B x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
⟹ case_sum A B (fst (x, y)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P ›
by simp
paragraph ‹Case Split›
subparagraph ‹Target›
lemma [φreason %ToA_splitting except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum _ _ ?var 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫 ›]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A a 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫)
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B b 𝗐𝗂𝗍𝗁 Q b @tag 𝒯𝒫)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B x 𝗐𝗂𝗍𝗁 case_sum P Q x @tag 𝒯𝒫 ›
by (cases x; simp)
lemma [φreason %ToA_splitting except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum _ _ ?var 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A a 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Ca a] Ra a 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫)
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B b 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cb b] Rb b 𝗐𝗂𝗍𝗁 Q b @tag 𝒯𝒫)
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B x 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[case_sum Ca Cb x] case_sum Ra Rb x 𝗐𝗂𝗍𝗁 case_sum P Q x @tag 𝒯𝒫 ›
by (cases x; simp add: Simplify_def)
lemma [φreason %ToA_splitting+1 except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (case_sum _ _ ?var) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ (xx, w⇩a a) ⦂ T ∗[C⇩W⇩a a] W⇩a a 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩a a ⦂ U⇩a a ∗[C⇩a a] R⇩a a 𝗐𝗂𝗍𝗁 P⇩a a @tag 𝒯𝒫')
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ (xx, w⇩b b) ⦂ T ∗[C⇩W⇩b b] W⇩b b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩b b ⦂ U⇩b b ∗[C⇩b b] R⇩b b 𝗐𝗂𝗍𝗁 P⇩b b @tag 𝒯𝒫')
⟹ (xx, case_sum w⇩a w⇩b x) ⦂ T ∗[case_sum C⇩W⇩a C⇩W⇩b x] (case_sum W⇩a W⇩b x)
𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum y⇩a y⇩b x ⦂ (case_sum U⇩a U⇩b x) ∗[case_sum C⇩a C⇩b x] (case_sum R⇩a R⇩b x) 𝗐𝗂𝗍𝗁 case_sum P⇩a P⇩b x @tag 𝒯𝒫' ›
unfolding Premise_def Try_def
by (cases x; simp)
lemma [φreason %ToA_splitting except ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (case_sum _ _ ?var) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›]:
‹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ (fst xx, w⇩a a) ⦂ T ∗[C⇩W⇩a a] W⇩a a 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩a a ⦂ U⇩a a ∗[C⇩a a] R⇩a a 𝗐𝗂𝗍𝗁 P⇩a a @tag 𝒯𝒫')
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ (fst xx, w⇩b b) ⦂ T ∗[C⇩W⇩b b] W⇩b b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y⇩b b ⦂ U⇩b b ∗[C⇩b b] R⇩b b 𝗐𝗂𝗍𝗁 P⇩b b @tag 𝒯𝒫')
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 S⇩a ∨ S⇩b
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 snd xx = case_sum w⇩a w⇩b x
⟹ xx ⦂ T ∗[case_sum C⇩W⇩a C⇩W⇩b x] (case_sum W⇩a W⇩b x)
𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum y⇩a y⇩b x ⦂ (case_sum U⇩a U⇩b x) ∗[case_sum C⇩a C⇩b x] (case_sum R⇩a R⇩b x) 𝗐𝗂𝗍𝗁 case_sum P⇩a P⇩b x @tag 𝒯𝒫' ›
unfolding Premise_def Try_def
by (cases x; cases xx; simp)
subparagraph ‹Source›
lemma ToA_case_sum_src:
‹ Y = case_sum Ya Yb x
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 P = (λ_. False) ∨⇩c⇩u⇩t (A a 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya a 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 Q = (λ_. False) ∨⇩c⇩u⇩t (B b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb b 𝗐𝗂𝗍𝗁 Q b @tag 𝒯𝒫))
⟹ case_sum A B x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 case_sum P Q x @tag 𝒯𝒫 ›
by (cases x; simp add: Simplify_def Premise_def Orelse_shortcut_def Ant_Seq_def)
lemma ToA_case_sum_src_R:
‹ Y = case_sum Ya Yb x
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (Ca,Ra,P) = ((λ_. True),0,(λ_. False)) ∨⇩c⇩u⇩t (A a 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya a 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Ca a] Ra a 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (Cb,Rb,Q) = ((λ_. True),0,(λ_. False)) ∨⇩c⇩u⇩t (B b 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb b 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cb b] Rb b 𝗐𝗂𝗍𝗁 Q b @tag 𝒯𝒫))
⟹ case_sum A B x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[case_sum Ca Cb x] case_sum Ra Rb x 𝗐𝗂𝗍𝗁 case_sum P Q x @tag 𝒯𝒫 ›
by (cases x; simp add: Simplify_def Premise_def Orelse_shortcut_def Ant_Seq_def)
lemma ToA_case_sum_src_W:
‹ Y = case_sum Ya Yb x
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 P = (λ_. False) ∨⇩c⇩u⇩t (A a * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya a 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 Q = (λ_. False) ∨⇩c⇩u⇩t (B b * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb b 𝗐𝗂𝗍𝗁 Q b @tag 𝒯𝒫))
⟹ case_sum A B x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 case_sum P Q x @tag 𝒯𝒫 ›
by (cases x; simp add: Simplify_def Premise_def Orelse_shortcut_def Ant_Seq_def)
lemma ToA_case_sum_src_WR:
‹ Y = case_sum Ya Yb x
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inl a ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (Ca,Ra,P) = ((λ_. True),0,(λ_. False)) ∨⇩c⇩u⇩t
(A a * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Ya a 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Ca a] Ra a 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫))
⟹ (⋀b. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = Inr b ⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 False ∧⇩𝗋 (Cb,Rb,Q) = ((λ_. True),0,(λ_. False)) ∨⇩c⇩u⇩t
(B b * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Yb b 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[Cb b] Rb b 𝗐𝗂𝗍𝗁 Q b @tag 𝒯𝒫))
⟹ case_sum A B x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[case_sum Ca Cb x] case_sum Ra Rb x 𝗐𝗂𝗍𝗁 case_sum P Q x @tag 𝒯𝒫 ›
by (cases x; simp add: Simplify_def Premise_def Orelse_shortcut_def Ant_Seq_def)
lemma case_sum_degenerate:
‹(case_sum (λ_. a) (λ_. a) x) ≡ a›
unfolding atomize_eq
by (cases x; simp)
lemma sum_case_distrib_fx:
‹(case_sum fa fb x) (case_sum va vb x) ≡ (case_sum (λx. fa x (va x)) (λx. fb x (vb x)) x)›
unfolding atomize_eq
by (cases x; simp)
lemma sum_case_distrib_arg:
‹(case_sum fa fb x) a ≡ (case_sum (λx. fa x a) (λx. fb x a) x)›
unfolding atomize_eq
by (cases x; simp)
ML ‹
fun reasoner_ToA_conditioned_subgoals_sum ctxt'N (vars,Y,RHS) =
let val (Ya, Yb, x) = Phi_Help.dest_triop_c \<^const_name>‹case_sum› RHS
val \<^Type>‹sum ta tb› = Thm.typ_of_cterm x
val ([Na,Nb], ctxt'N) = Variable.variant_fixes ["xa","xb"] ctxt'N
val xa = Thm.cterm_of ctxt'N (Free (Na, ta))
val xb = Thm.cterm_of ctxt'N (Free (Nb, tb))
val x_term = Thm.term_of x
val Ya_s = map (fn ((N,i),ty) => Thm.apply (Thm.var ((N,i+2), Thm.ctyp_of ctxt'N (ta --> ty))) xa) vars
val Yb_s = map (fn ((N,i),ty) => Thm.apply (Thm.var ((N,i+3), Thm.ctyp_of ctxt'N (tb --> ty))) xb) vars
val Y_s = map2 (fn a => fn b =>
let val ty = Thm.typ_of_cterm a
in Thm.apply (Thm.apply (Thm.apply (
Thm.cterm_of ctxt'N \<^Const>‹case_sum ta ty tb›) (Thm.dest_fun a)
) (Thm.dest_fun b)) x
end) Ya_s Yb_s
val Ya' = Thm.instantiate_cterm (TVars.empty, Vars.make (vars ~~ Ya_s)) Y
|> Thm.lambda xa
val Yb' = Thm.instantiate_cterm (TVars.empty, Vars.make (vars ~~ Yb_s)) Y
|> Thm.lambda xb
fun mk_inst ctm Y =
case Thm.term_of ctm
of _ $ Free _ => mk_inst (Thm.dest_fun ctm) (Thm.lambda (Thm.dest_arg ctm) Y)
| Var v => (v, Y)
| _ => error "BUG: reasoner_ToA_conditioned_subgoals"
in (Vars.make (mk_inst Ya Ya' :: mk_inst Yb Yb' :: (vars ~~ Y_s)), x_term)
end
›
φreasoner_ML ‹ML (case_sum A B x 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)› %ToA_splitting
( ‹case_sum _ _ _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
| except ‹case_sum _ _ ?var 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›)
= ‹Phi_Reasoners.reasoner_ToA_conditioned_subgoals
(@{thm' ToA_case_sum_src}, @{thm' ToA_case_sum_src_R},
(true, @{thms' case_sum_degenerate}, @{thms' sum.case}),
reasoner_ToA_conditioned_subgoals_sum, \<^context>) o snd›
φreasoner_ML ‹ML (case_sum A B x * W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)› %ToA_splitting
( ‹case_sum _ _ _ * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›
| except ‹case_sum _ _ ?var * _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫› )
= ‹Phi_Reasoners.reasoner_ToA_conditioned_subgoals
(@{thm' ToA_case_sum_src_W}, @{thm' ToA_case_sum_src_WR},
(true, @{thms' case_sum_degenerate}, @{thms' sum.case}),
reasoner_ToA_conditioned_subgoals_sum, \<^context>) o snd›
paragraph ‹When the sum type is a variable›
subparagraph ‹Normalizing›
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B var 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B (id var) 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B var 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum A B (id var) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R 𝗐𝗂𝗍𝗁 P›
by simp
lemma [φreason %ToA_red]:
‹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (case_sum A B var) ∗[C] R 𝗐𝗂𝗍𝗁 P
⟹ X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ (case_sum A B (id var)) ∗[C] R 𝗐𝗂𝗍𝗁 P›
by simp
subparagraph ‹Major Reasoning›
declare [[
φreason ! %ToA_branches ToA_case_sum_target_L ToA_case_sum_target_R
for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum _ _ ?var 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›,
φreason ! %ToA_branches ToA_case_sum_target_L' ToA_case_sum_target_R'
for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 case_sum _ _ ?var 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫›,
φreason ! %ToA_branches ToA_case_sum_target_L_ty ToA_case_sum_target_R_ty
for ‹_ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ ⦂ (case_sum _ _ ?var) ∗[_] _ 𝗐𝗂𝗍𝗁 _ @tag 𝒯𝒫'›
]]
section ‹Helpful Stuffs›
subsection ‹Methods›
method_setup represent_BI_pred_in_φType = ‹Args.term >> (fn X => fn ctxt => Method.METHOD (K (fn th =>
let val T = Thm.cterm_of ctxt X
val ty_a = Thm.ctyp_of_cterm T |> Thm.dest_ctyp0
val ty_c = Thm.ctyp_of_cterm T |> Thm.dest_ctyp1 |> Thm.dest_ctyp0
in case Thm.prop_of th
of Const(\<^const_name>‹Pure.imp›, _) $ _ $ _ =>
Seq.single (Conv.gconv_rule (Conv.bottom_conv (fn _ => fn ctm =>
case Thm.term_of ctm
of X' $ _ => if X' aconv X
then Conv.rewr_conv \<^instantiate>‹T and x = ‹Thm.dest_arg ctm›
and 'c = ty_c and 'a = ty_a
in lemma ‹T x ≡ x ⦂ T› for T :: ‹('c,'a) φ›
by (simp add: φType_def)› ctm
else Conv.all_conv ctm
| _ => Conv.all_conv ctm
) ctxt) 1 th)
| _ => Seq.empty
end
)))›
end